From 68fa7ed3dc3f28b9571201878a6005f31a260dd9 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 11:45:32 +0200 Subject: [PATCH 01/48] wip --- src/Compiler/FSharp.Compiler.Service.fsproj | 1 + src/Compiler/Utilities/Async2.fs | 373 ++++++++++++++++++++ 2 files changed, 374 insertions(+) create mode 100644 src/Compiler/Utilities/Async2.fs diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 5db9b2e1b2..c130e15933 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -128,6 +128,7 @@ + diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs new file mode 100644 index 0000000000..67be864a3a --- /dev/null +++ b/src/Compiler/Utilities/Async2.fs @@ -0,0 +1,373 @@ +namespace Internal.Utilities.Async2 + +module internal Implementation = + + open System + open System.Threading + open System.Threading.Tasks + + open FSharp.Core.CompilerServices.StateMachineHelpers + + open Microsoft.FSharp.Core.CompilerServices + open System.Runtime.CompilerServices + open System.Runtime.ExceptionServices + + /// A structure that looks like an Awaiter + type Awaiter<'Awaiter, 'TResult + when 'Awaiter :> ICriticalNotifyCompletion + and 'Awaiter: (member get_IsCompleted: unit -> bool) + and 'Awaiter: (member GetResult: unit -> 'TResult)> = 'Awaiter + + type Awaitable<'Awaitable, 'Awaiter, 'TResult + when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable + + module Awaiter = + let inline isCompleted (awaiter: ^Awaiter) : bool + when ^Awaiter : (member get_IsCompleted : unit -> bool) = + awaiter.get_IsCompleted() + + let inline getResult (awaiter: ^Awaiter) : ^TResult + when ^Awaiter : (member GetResult : unit -> ^TResult) = + awaiter.GetResult() + + let inline onCompleted (awaiter: ^Awaiter) (continuation: Action) : unit + when ^Awaiter :> INotifyCompletion = + awaiter.OnCompleted continuation + + let inline unsafeOnCompleted (awaiter: ^Awaiter) (continuation: Action) : unit + when ^Awaiter :> ICriticalNotifyCompletion = + awaiter.UnsafeOnCompleted continuation + + type Trampoline private () = + + let ownerThreadId = Thread.CurrentThread.ManagedThreadId + + static let holder = new ThreadLocal<_>(fun () -> Trampoline()) + + let mutable pending : Action voption = ValueNone + let mutable running = false + + let start (action: Action) = + try + running <- true + action.Invoke() + while pending.IsSome do + let next = pending.Value + pending <- ValueNone + next.Invoke() + finally + running <- false + + let set action = + assert (Thread.CurrentThread.ManagedThreadId = ownerThreadId) + assert pending.IsNone + if running then + pending <- ValueSome action + else + start action + + interface ICriticalNotifyCompletion with + member _.OnCompleted(continuation) = set continuation + member _.UnsafeOnCompleted(continuation) = set continuation + + static member Current = holder.Value + + module Trampoline = + let Awaiter : ICriticalNotifyCompletion = Trampoline.Current + let AwaiterRef = ref Awaiter + + module BindContext = + [] + let bindLimit = 100 + + let bindCount = new ThreadLocal() + + let inline IncrementBindCount () = + bindCount.Value <- bindCount.Value + 1 + bindCount.Value % bindLimit = 0 + + module ExceptionCache = + let store = ConditionalWeakTable() + + let inline CaptureOrRetrieve (exn: exn) = + match store.TryGetValue exn with + | true, edi when edi.SourceException = exn -> edi + | _ -> + let edi = ExceptionDispatchInfo.Capture exn + + try store.Add(exn, edi) with _ -> () + + edi + + let inline Throw(exn: exn) = + let edi = CaptureOrRetrieve exn + edi.Throw() + Unchecked.defaultof<_> + + let inline GetResultOrThrow awaiter = try Awaiter.getResult awaiter with exn -> Throw exn + + type Async2 = + static let token = AsyncLocal() + static member UseToken ct = token.Value <- ct + static member val Token = token.Value + + [] + type Async2Data<'t> = + [] + val mutable Result: 't + + [] + val mutable MethodBuilder: AsyncTaskMethodBuilder<'t> + + [] + val mutable Hijack: bool + + type Async2StateMachine<'TOverall> = ResumableStateMachine> + type IAsync2StateMachine<'TOverall> = IResumableStateMachine> + type Async2ResumptionFunc<'TOverall> = ResumptionFunc> + type Async2ResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> + type Async2Code<'TOverall, 'T> = ResumableCode, 'T> + + [] + type Async2<'T>(start: bool -> Task<'T>) = + + member internal _.Start() = start false + + member internal _.StartBound() = start true + + [] + module Async2Code = + let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = + Async2Code(fun sm -> + match exn with + | :? OperationCanceledException as oce when oce.CancellationToken = Async2.Token -> raise exn + | _ -> (catch exn).Invoke(&sm)) + + let inline throwIfCancellationRequested (code: Async2Code<_, _>) = + Async2Code(fun sm -> + Async2.Token.ThrowIfCancellationRequested() + code.Invoke(&sm)) + + [] + type DynamicState = + | InitialYield + | Running + | SetResult + | SetException of ExceptionDispatchInfo + + [] + type DynamicContinuation = + | Stop + | Immediate + | Await of ICriticalNotifyCompletion + + let inline yieldOnBindLimit () = + Async2Code<_, _>(fun sm -> + if sm.Data.Hijack then + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + if not __stack_yield_fin then + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(Trampoline.AwaiterRef, &sm) + __stack_yield_fin + else + true + ) + + type Async2Builder() = + + member inline _.Delay(generator: unit -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = + ResumableCode.Delay(fun () -> generator () |> throwIfCancellationRequested) + + [] + member inline _.Zero() : Async2Code<'TOverall, unit> = ResumableCode.Zero() + + member inline _.Return(value: 'T) = Async2Code(fun sm -> sm.Data.Result <- value; true) + + member inline _.Combine + (code1: Async2Code<'TOverall, unit>, code2: Async2Code<'TOverall, 'T>) + : Async2Code<'TOverall, 'T> = + ResumableCode.Combine(code1, code2) + + member inline _.While + ([] condition: unit -> bool, body: Async2Code<'TOverall, unit>) + : Async2Code<'TOverall, unit> = + ResumableCode.While(condition, throwIfCancellationRequested body) + + member inline _.TryWith + (body: Async2Code<'TOverall, 'T>, catch: exn -> Async2Code<'TOverall, 'T>) + : Async2Code<'TOverall, 'T> = + ResumableCode.TryWith(body, filterCancellation catch) + + member inline _.TryFinally + (body: Async2Code<'TOverall, 'T>, [] compensation: unit -> unit) + : Async2Code<'TOverall, 'T> = + ResumableCode.TryFinally( + body, + ResumableCode<_, _>(fun _sm -> + compensation () + true) + ) + + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable | null> + (resource: 'Resource, body: 'Resource -> Async2Code<'TOverall, 'T>) + : Async2Code<'TOverall, 'T> = + ResumableCode.Using(resource, body) + + member inline _.For(sequence: seq<'T>, body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = + ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) + + [] + static member inline BindDynamic(sm: byref>, awaiter, continuation: _ -> Async2Code<_, _>) = + if Awaiter.isCompleted awaiter then + (Awaiter.getResult awaiter |> continuation).Invoke(&sm) + else + let resumptionFunc = Async2ResumptionFunc(fun sm -> + let result = ExceptionCache.GetResultOrThrow awaiter + (continuation result).Invoke(&sm)) + sm.ResumptionDynamicInfo.ResumptionFunc <- resumptionFunc + sm.ResumptionDynamicInfo.ResumptionData <- awaiter :> ICriticalNotifyCompletion + false + + [] + member inline _.Bind + (awaiter, continuation: 'U -> Async2Code<'Data, 'T>) + : Async2Code<'Data, 'T> = + Async2Code(fun sm -> + if __useResumableCode then + if Awaiter.isCompleted awaiter then + continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) + else + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + if __stack_yield_fin then + continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) + else + let mutable __stack_awaiter = awaiter + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&__stack_awaiter, &sm) + false + else + Async2Builder.BindDynamic(&sm, awaiter, continuation) + ) + + [] + member inline this.ReturnFrom(awaiter) : Async2Code<'T, 'T> = this.Bind(awaiter, this.Return) + + static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = + let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) + + let resumptionInfo () = + let mutable state = InitialYield + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc) with + member info.MoveNext(sm) = + let mutable continuation = Stop + + let hijackCheck = if sm.Data.Hijack then Await Trampoline.Awaiter else Immediate + + let current = state + match current with + | InitialYield -> + state <- Running + continuation <- hijackCheck + | Running -> + try + let step = info.ResumptionFunc.Invoke(&sm) + if step then + state <- SetResult + continuation <- hijackCheck + else + continuation <- Await (info.ResumptionData :?> ICriticalNotifyCompletion) + with exn -> + state <- SetException (ExceptionCache.CaptureOrRetrieve exn) + continuation <- hijackCheck + | SetResult -> sm.Data.MethodBuilder.SetResult sm.Data.Result + | SetException edi -> sm.Data.MethodBuilder.SetException(edi.SourceException) + + match continuation with + | Await awaiter -> + sm.ResumptionDynamicInfo.ResumptionData <- null + let mutable awaiter = awaiter + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + | Immediate -> info.MoveNext &sm + | Stop -> () + + member _.SetStateMachine(sm, state) = + sm.Data.MethodBuilder.SetStateMachine(state) + } + + Async2(fun bound -> + let mutable copy = Async2StateMachine() + copy.ResumptionDynamicInfo <- resumptionInfo () + copy.Data <- Async2Data() + copy.Data.Hijack <- bound && BindContext.IncrementBindCount() + copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() + copy.Data.MethodBuilder.Start(©) + copy.Data.MethodBuilder.Task) + + member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = + if __useResumableCode then + __stateMachine, _> + + (MoveNextMethodImpl<_>(fun sm -> + __resumeAt sm.ResumptionPoint + let mutable error = null + + let __stack_go1 = yieldOnBindLimit().Invoke(&sm) + if __stack_go1 then + try + let __stack_code_fin = code.Invoke(&sm) + if __stack_code_fin then + let __stack_go2 = yieldOnBindLimit().Invoke(&sm) + if __stack_go2 then + sm.Data.MethodBuilder.SetResult(sm.Data.Result) + with exn -> + error <- ExceptionCache.CaptureOrRetrieve exn + + if error <> null then + let __stack_go2 = yieldOnBindLimit().Invoke(&sm) + if __stack_go2 then + sm.Data.MethodBuilder.SetException(error.SourceException) + )) + + (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) + + (AfterCode<_, _>(fun sm -> + let mutable copy = sm + Async2(fun bound -> + copy.Data <- Async2Data() + copy.Data.Hijack <- bound && BindContext.IncrementBindCount() + copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() + copy.Data.MethodBuilder.Start(©) + copy.Data.MethodBuilder.Task) + )) + else + Async2Builder.RunDynamic(code) + + member inline _.Source(code: Async2<_>) = code.StartBound() |> _.GetAwaiter() + + [] + module Async2AutoOpens = + + let async2 = Async2Builder() + + [] + module SourceExtensions = + type Async2Builder with + member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() + member inline _.Source(task: Task) = task.GetAwaiter() + member inline _.Source(items: #seq<_>) : seq<_> = upcast items + + module Async2 = + + let run (code: Async2<'t>) = + if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then + code.Start().GetAwaiter().GetResult() + else + Task.Run<'t>(code.Start).GetAwaiter().GetResult() + + let startAsTask (code: Async2<'t>) = code.Start() + + let runWithoutCancellation code = run code + + + + + + From b79b3bfec448bb3049c2ca21c9e25627552859f5 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 11:56:35 +0200 Subject: [PATCH 02/48] wip --- src/Compiler/Utilities/Async2.fs | 63 +++++++++++++++----------------- 1 file changed, 29 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 67be864a3a..7bfde0a064 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -1,10 +1,28 @@ -namespace Internal.Utilities.Async2 +namespace Internal.Utilities -module internal Implementation = +open System +open System.Threading +open System.Threading.Tasks - open System - open System.Threading - open System.Threading.Tasks +[] +type internal Async2<'T> (start: bool -> Task<'T>) = + + member _.Start() = start false + member _.StartBound() = start true + +module internal Async2 = + + let run (code: Async2<'t>) = + if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then + code.Start().GetAwaiter().GetResult() + else + Task.Run<'t>(code.Start).GetAwaiter().GetResult() + + let startAsTask (code: Async2<'t>) = code.Start() + + let runWithoutCancellation code = run code + +module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -128,13 +146,6 @@ module internal Implementation = type Async2ResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> type Async2Code<'TOverall, 'T> = ResumableCode, 'T> - [] - type Async2<'T>(start: bool -> Task<'T>) = - - member internal _.Start() = start false - - member internal _.StartBound() = start true - [] module Async2Code = let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = @@ -341,33 +352,17 @@ module internal Implementation = Async2Builder.RunDynamic(code) member inline _.Source(code: Async2<_>) = code.StartBound() |> _.GetAwaiter() - - [] - module Async2AutoOpens = - - let async2 = Async2Builder() - + [] module SourceExtensions = type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() member inline _.Source(task: Task) = task.GetAwaiter() - member inline _.Source(items: #seq<_>) : seq<_> = upcast items - - module Async2 = - - let run (code: Async2<'t>) = - if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - code.Start().GetAwaiter().GetResult() - else - Task.Run<'t>(code.Start).GetAwaiter().GetResult() + member inline _.Source(items: #seq<_>) : seq<_> = upcast items - let startAsTask (code: Async2<'t>) = code.Start() - let runWithoutCancellation code = run code - - - - - +[] +module internal Async2AutoOpens = + open Async2Implementation + let async2 = Async2Builder() From 7955b652853c4739681a0dd7693455cc0edc0cb8 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 12:05:49 +0200 Subject: [PATCH 03/48] wip --- src/Compiler/Utilities/Async2.fs | 49 ++++++++++++++++---------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 7bfde0a064..dcb1a6467a 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -4,24 +4,6 @@ open System open System.Threading open System.Threading.Tasks -[] -type internal Async2<'T> (start: bool -> Task<'T>) = - - member _.Start() = start false - member _.StartBound() = start true - -module internal Async2 = - - let run (code: Async2<'t>) = - if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - code.Start().GetAwaiter().GetResult() - else - Task.Run<'t>(code.Start).GetAwaiter().GetResult() - - let startAsTask (code: Async2<'t>) = code.Start() - - let runWithoutCancellation code = run code - module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -128,6 +110,14 @@ module internal Async2Implementation = static let token = AsyncLocal() static member UseToken ct = token.Value <- ct static member val Token = token.Value + + [] + type internal Async2<'T> (start: bool -> Task<'T>) = + + member _.Start() = start false + member _.GetAwaiter() = + let hijack = BindContext.IncrementBindCount() + (start hijack).GetAwaiter() [] type Async2Data<'t> = @@ -303,11 +293,11 @@ module internal Async2Implementation = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2(fun bound -> + Async2(fun hijack -> let mutable copy = Async2StateMachine() copy.ResumptionDynamicInfo <- resumptionInfo () copy.Data <- Async2Data() - copy.Data.Hijack <- bound && BindContext.IncrementBindCount() + copy.Data.Hijack <- hijack copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) @@ -341,9 +331,9 @@ module internal Async2Implementation = (AfterCode<_, _>(fun sm -> let mutable copy = sm - Async2(fun bound -> + Async2(fun hijack -> copy.Data <- Async2Data() - copy.Data.Hijack <- bound && BindContext.IncrementBindCount() + copy.Data.Hijack <- hijack copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) @@ -351,8 +341,6 @@ module internal Async2Implementation = else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code.StartBound() |> _.GetAwaiter() - [] module SourceExtensions = type Async2Builder with @@ -366,3 +354,16 @@ module internal Async2AutoOpens = open Async2Implementation let async2 = Async2Builder() + +module internal Async2 = + open Async2Implementation + + let run (code: Async2<'t>) = + if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then + code.Start().GetAwaiter().GetResult() + else + Task.Run<'t>(code.Start).GetAwaiter().GetResult() + + let startAsTask (code: Async2<'t>) = code.Start() + + let runWithoutCancellation code = run code From 0c9863c96116c950e4b8c61a30fe9c99b94163ea Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 12:56:34 +0200 Subject: [PATCH 04/48] wip --- src/Compiler/Utilities/Async2.fs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index dcb1a6467a..4d4cf566e4 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -4,6 +4,8 @@ open System open System.Threading open System.Threading.Tasks +#nowarn 3513 + module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -274,7 +276,9 @@ module internal Async2Implementation = state <- SetResult continuation <- hijackCheck else - continuation <- Await (info.ResumptionData :?> ICriticalNotifyCompletion) + match info.ResumptionData with + | :? ICriticalNotifyCompletion as awaiter -> continuation <- Await awaiter + | _ -> failwith "invalid awaiter" with exn -> state <- SetException (ExceptionCache.CaptureOrRetrieve exn) continuation <- hijackCheck @@ -308,7 +312,7 @@ module internal Async2Implementation = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint - let mutable error = null + let mutable error = ValueNone let __stack_go1 = yieldOnBindLimit().Invoke(&sm) if __stack_go1 then @@ -319,12 +323,12 @@ module internal Async2Implementation = if __stack_go2 then sm.Data.MethodBuilder.SetResult(sm.Data.Result) with exn -> - error <- ExceptionCache.CaptureOrRetrieve exn + error <- ValueSome (ExceptionCache.CaptureOrRetrieve exn) - if error <> null then + if error.IsSome then let __stack_go2 = yieldOnBindLimit().Invoke(&sm) if __stack_go2 then - sm.Data.MethodBuilder.SetException(error.SourceException) + sm.Data.MethodBuilder.SetException(error.Value.SourceException) )) (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) From 5719e57568bef7da60b31af69b02ed8f5631a456 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 13:25:12 +0200 Subject: [PATCH 05/48] wip --- src/Compiler/Utilities/Async2.fs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 4d4cf566e4..3870cbef71 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -6,6 +6,11 @@ open System.Threading.Tasks #nowarn 3513 +type Async2 = + static let token = AsyncLocal() + static member UseToken ct = token.Value <- ct + static member val Token = token.Value + module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -107,11 +112,6 @@ module internal Async2Implementation = Unchecked.defaultof<_> let inline GetResultOrThrow awaiter = try Awaiter.getResult awaiter with exn -> Throw exn - - type Async2 = - static let token = AsyncLocal() - static member UseToken ct = token.Value <- ct - static member val Token = token.Value [] type internal Async2<'T> (start: bool -> Task<'T>) = @@ -362,7 +362,8 @@ module internal Async2AutoOpens = module internal Async2 = open Async2Implementation - let run (code: Async2<'t>) = + let run ct (code: Async2<'t>) = + Async2.UseToken ct if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then code.Start().GetAwaiter().GetResult() else @@ -370,4 +371,4 @@ module internal Async2 = let startAsTask (code: Async2<'t>) = code.Start() - let runWithoutCancellation code = run code + let runWithoutCancellation code = run CancellationToken.None code From 35cad0fc39965b053665ca3af475b661befe9202 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 13:32:17 +0200 Subject: [PATCH 06/48] wip --- src/Compiler/Checking/CheckDeclarations.fs | 18 +- src/Compiler/Checking/CheckDeclarations.fsi | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 14 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 +- src/Compiler/Service/BackgroundCompiler.fs | 6 +- src/Compiler/Service/FSharpCheckerResults.fs | 10 +- src/Compiler/Service/FSharpCheckerResults.fsi | 6 +- src/Compiler/Service/TransparentCompiler.fs | 4 +- src/Compiler/Utilities/Async2.fs | 7 +- src/Compiler/Utilities/Cancellable.fs | 174 ------------------ src/Compiler/Utilities/Cancellable.fsi | 65 ------- 13 files changed, 41 insertions(+), 277 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 07b40b6b11..9f8d035128 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4871,8 +4871,8 @@ module TcDeclarations = // Bind module types //------------------------------------------------------------------------- -let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Cancellable = - cancellable { +let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async2 = + async2 { let g = cenv.g try match synSigDecl with @@ -5028,7 +5028,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = - cancellable { + async2 { // Ensure the .Deref call in UpdateAccModuleOrNamespaceType succeeds if cenv.compilingCanonicalFslibModuleType then let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs @@ -5047,7 +5047,7 @@ and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = Cancellable.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (defs: SynModuleSigDecl list) = - cancellable { + async2 { let m = match defs with [] -> m | _ -> defs |> List.map (fun d -> d.Range) |> List.reduce unionRanges let scopem = (defs, m) ||> List.foldBack (fun h m -> unionRanges h.Range m) @@ -5102,7 +5102,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, moduleKind, defs, m: range, xml) = - cancellable { + async2 { let endm = m.EndRange // use end of range for errors // Create the module type that will hold the results of type checking.... @@ -5260,7 +5260,7 @@ let TcModuleOrNamespaceElementsMutRec (cenv: cenv) parent typeNames m envInitial /// The non-mutually recursive case for a declaration let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl = - cancellable { + async2 { let g = cenv.g cenv.synArgNameGenerator.Reset() let tpenv = emptyUnscopedTyparEnv @@ -5525,7 +5525,7 @@ and [] TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 synModuleDecls = - cancellable { + async2 { // Ensure the deref_nlpath call in UpdateAccModuleOrNamespaceType succeeds if cenv.compilingCanonicalFslibModuleType then let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs @@ -5773,7 +5773,7 @@ let CheckOneImplFile let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, _, implFileFrags, isLastCompiland, _, _)) = synImplFile let infoReader = InfoReader(g, amap) - cancellable { + async2 { use _ = Activity.start "CheckDeclarations.CheckOneImplFile" [| @@ -5918,7 +5918,7 @@ let CheckOneImplFile /// Check an entire signature file let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) = - cancellable { + async2 { use _ = Activity.start "CheckDeclarations.CheckOneSigFile" [| diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index 9b06fcc828..1a2be70f80 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -60,7 +60,7 @@ val CheckOneImplFile: ModuleOrNamespaceType option * ParsedImplFileInput * FSharpDiagnosticOptions -> - Cancellable + Async2 val CheckOneSigFile: TcGlobals * @@ -73,7 +73,7 @@ val CheckOneSigFile: FSharpDiagnosticOptions -> TcEnv -> ParsedSigFileInput -> - Cancellable + Async2 exception NotUpperCaseConstructor of range: range diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index fd6eabbf0f..5b9a156ec6 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1225,8 +1225,8 @@ let CheckOneInput tcSink: TcResultsSink, tcState: TcState, input: ParsedInput - ) : Cancellable = - cancellable { + ) : Async2 = + async2 { try use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] @@ -1344,7 +1344,7 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, oldLogger) = /// Typecheck a single file (or interactive entry into F# Interactive) let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input = - cancellable { + async2 { // Equip loggers to locally filter w.r.t. scope pragmas in each input use _ = UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, oldLogger)) @@ -1371,7 +1371,7 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = (tcEnvAtEndOfLastFile, topAttrs, implFiles, ccuSigsForFiles), tcState let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = - cancellable { + async2 { let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) let finishedResult = CheckMultipleInputsFinish([ result ], tcState) return finishedResult @@ -1445,8 +1445,8 @@ let CheckOneInputWithCallback _skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool ) - : Cancellable> = - cancellable { + : Async2> = + async2 { try CheckSimulateException tcConfig @@ -1820,7 +1820,7 @@ let CheckMultipleInputsUsingGraphMode : Finisher = let (Finisher(finisher = finisher)) = - cancellable { + async2 { use _ = UseDiagnosticsLogger logger let checkForErrors2 () = diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 281638b568..6233cd17c1 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -180,7 +180,7 @@ val CheckOneInput: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> + Async2<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> val CheckOneInputWithCallback: node: NodeToTypeCheck -> @@ -193,7 +193,7 @@ val CheckOneInputWithCallback: tcState: TcState * input: ParsedInput * _skipImplIfSigExists: bool -> - Cancellable> + Async2> val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -248,4 +248,4 @@ val CheckOneInputAndFinish: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Cancellable<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> + Async2<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index eb96a5f6e0..a7316ab972 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -910,7 +910,7 @@ type StackGuard(maxDepth: int, name: string) = depth <- depth - 1 [] - member x.GuardCancellable(original: Cancellable<'T>) = + member x.GuardCancellable(original: Async2<'T>) = Cancellable(fun ct -> x.Guard(fun () -> Cancellable.run ct original)) static member val DefaultDepth = diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 02471dd383..2a7b041119 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -470,7 +470,7 @@ type StackGuard = [] line: int -> 'T - member GuardCancellable: Internal.Utilities.Library.Cancellable<'T> -> Internal.Utilities.Library.Cancellable<'T> + member GuardCancellable: Internal.Utilities.Library.Async2<'T> -> Internal.Utilities.Library.Async2<'T> static member GetDepthOption: string -> int diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 1b00bcb1ff..cf6cd09931 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -330,7 +330,7 @@ type internal BackgroundCompiler | FSharpReferencedProject.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async2 { let! ilReaderOpt = delayedReader.TryGetILModuleReader() match ilReaderOpt with @@ -352,7 +352,7 @@ type internal BackgroundCompiler | FSharpReferencedProject.ILModuleReference(nm, getStamp, getReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async2 { let ilReader = getReader () let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData @@ -1294,7 +1294,7 @@ type internal BackgroundCompiler "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] - cancellable { + async2 { // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true let useSdkRefs = defaultArg useSdkRefs true diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index aa23d1534a..df8538562b 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -87,7 +87,7 @@ type DelayedILModuleReader = // fast path match box this.result with | null -> - cancellable { + async2 { let! ct = Cancellable.token () return @@ -3209,7 +3209,7 @@ module internal ParseAndCheckFile = suggestNamesForErrors: bool ) = - cancellable { + async2 { use _ = Activity.start "ParseAndCheckFile.CheckOneFile" @@ -3235,7 +3235,7 @@ module internal ParseAndCheckFile = let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) let! resOpt = - cancellable { + async2 { try let checkForErrors () = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -3683,7 +3683,7 @@ type FSharpCheckFileResults keepAssemblyContents: bool, suggestNamesForErrors: bool ) = - cancellable { + async2 { let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile( parseResults, @@ -3923,7 +3923,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let keepAssemblyContents = false member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = - cancellable { + async2 { let userOpName = defaultArg userOpName "Unknown" let fileName = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 9418d9a4f3..8aefb7f825 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -46,7 +46,7 @@ type DelayedILModuleReader = /// Will lazily create the ILModuleReader. /// Is only evaluated once and can be called by multiple threads. - member internal TryGetILModuleReader: unit -> Cancellable + member internal TryGetILModuleReader: unit -> Async2 /// Unused in this API type public FSharpUnresolvedReferencesSet = internal FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list @@ -501,7 +501,7 @@ type public FSharpCheckFileResults = parseErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool -> - Cancellable + Async2 /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -618,7 +618,7 @@ type internal FsiInteractiveChecker = member internal ParseAndCheckInteraction: sourceText: ISourceText * ?userOpName: string -> - Cancellable + Async2 module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 0c3f01d4a3..1525e75e2f 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -771,7 +771,7 @@ type internal TransparentCompiler | FSharpReferencedProjectSnapshot.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async2 { let! ilReaderOpt = delayedReader.TryGetILModuleReader() match ilReaderOpt with @@ -793,7 +793,7 @@ type internal TransparentCompiler | FSharpReferencedProjectSnapshot.ILModuleReference(nm, getStamp, getReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async2 { let ilReader = getReader () let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 3870cbef71..29a3a3cdc0 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -1,4 +1,4 @@ -namespace Internal.Utilities +namespace Internal.Utilities.Library open System open System.Threading @@ -344,6 +344,8 @@ module internal Async2Implementation = )) else Async2Builder.RunDynamic(code) + + member inline _.Source(code: Async2<_>) = code.GetAwaiter() [] module SourceExtensions = @@ -352,13 +354,14 @@ module internal Async2Implementation = member inline _.Source(task: Task) = task.GetAwaiter() member inline _.Source(items: #seq<_>) : seq<_> = upcast items - [] module internal Async2AutoOpens = open Async2Implementation let async2 = Async2Builder() +type Async2<'t> = Async2Implementation.Async2<'t> + module internal Async2 = open Async2Implementation diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index bae9c6f829..f1788f6aa1 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -50,177 +50,3 @@ type Cancellable = match tokenHolder.Value with | ValueNone -> () | ValueSome token -> token.ThrowIfCancellationRequested() - -namespace Internal.Utilities.Library - -open System -open System.Threading -open FSharp.Compiler - -open FSharp.Core.CompilerServices.StateMachineHelpers - -[] -type ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException - -[] -type Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) - -module Cancellable = - - let inline run (ct: CancellationToken) (Cancellable oper) = - if ct.IsCancellationRequested then - ValueOrCancelled.Cancelled(OperationCanceledException ct) - else - try - oper ct - with - | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e - | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise - - let fold f acc seq = - Cancellable(fun ct -> - let mutable acc = ValueOrCancelled.Value acc - - for x in seq do - match acc with - | ValueOrCancelled.Value accv -> acc <- run ct (f accv x) - | ValueOrCancelled.Cancelled _ -> () - - acc) - - let runWithoutCancellation comp = - use _ = Cancellable.UsingToken CancellationToken.None - let res = run CancellationToken.None comp - - match res with - | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" - | ValueOrCancelled.Value r -> r - - let toAsync c = - async { - use! _holder = Cancellable.UseToken() - - let! ct = Async.CancellationToken - - return! - Async.FromContinuations(fun (cont, _econt, ccont) -> - match run ct c with - | ValueOrCancelled.Value v -> cont v - | ValueOrCancelled.Cancelled ce -> ccont ce) - } - - let token () = Cancellable(ValueOrCancelled.Value) - -type CancellableBuilder() = - - member inline _.Delay([] f) = - Cancellable(fun ct -> - let (Cancellable g) = f () - g ct) - - member inline _.Bind(comp, [] k) = - Cancellable(fun ct -> - - __debugPoint "" - - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> Cancellable.run ct (k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.BindReturn(comp, [] k) = - Cancellable(fun ct -> - - __debugPoint "" - - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Combine(comp1, comp2) = - Cancellable(fun ct -> - - __debugPoint "" - - match Cancellable.run ct comp1 with - | ValueOrCancelled.Value() -> Cancellable.run ct comp2 - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.TryWith(comp, [] handler) = - Cancellable(fun ct -> - - __debugPoint "" - - let compRes = - try - match Cancellable.run ct comp with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> Cancellable.run ct (handler err) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Using(resource: _ MaybeNull, [] comp) = - Cancellable(fun ct -> - - __debugPoint "" - - let body = comp resource - - let compRes = - try - match Cancellable.run ct body with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.TryFinally(comp, [] compensation) = - Cancellable(fun ct -> - - __debugPoint "" - - let compRes = - try - match Cancellable.run ct comp with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - compensation () - - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Return v = - Cancellable(fun _ -> ValueOrCancelled.Value v) - - member inline _.ReturnFrom(v: Cancellable<'T>) = v - - member inline _.Zero() = - Cancellable(fun _ -> ValueOrCancelled.Value()) - -[] -module CancellableAutoOpens = - let cancellable = CancellableBuilder() diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 0d82faa68c..880a31199f 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -12,68 +12,3 @@ type Cancellable = static member CheckAndThrow: unit -> unit static member TryCheckAndThrow: unit -> unit - -namespace Internal.Utilities.Library - -open System -open System.Threading - -[] -type internal ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException - -/// Represents a synchronous, cold-start, cancellable computation with explicit representation of a cancelled result. -/// -/// A cancellable computation may be cancelled via a CancellationToken, which is propagated implicitly. -/// If cancellation occurs, it is propagated as data rather than by raising an OperationCanceledException. -[] -type internal Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) - -module internal Cancellable = - - /// Run a cancellable computation using the given cancellation token - val inline run: ct: CancellationToken -> Cancellable<'T> -> ValueOrCancelled<'T> - - val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> - - /// Run the computation in a mode where it may not be cancelled. The computation never results in a - /// ValueOrCancelled.Cancelled. - val runWithoutCancellation: comp: Cancellable<'T> -> 'T - - /// Bind the cancellation token associated with the computation - val token: unit -> Cancellable - - val toAsync: Cancellable<'T> -> Async<'T> - -type internal CancellableBuilder = - - new: unit -> CancellableBuilder - - member inline BindReturn: comp: Cancellable<'T> * [] k: ('T -> 'U) -> Cancellable<'U> - - member inline Bind: comp: Cancellable<'T> * [] k: ('T -> Cancellable<'U>) -> Cancellable<'U> - - member inline Combine: comp1: Cancellable * comp2: Cancellable<'T> -> Cancellable<'T> - - member inline Delay: [] f: (unit -> Cancellable<'T>) -> Cancellable<'T> - - member inline Return: v: 'T -> Cancellable<'T> - - member inline ReturnFrom: v: Cancellable<'T> -> Cancellable<'T> - - member inline TryFinally: comp: Cancellable<'T> * [] compensation: (unit -> unit) -> Cancellable<'T> - - member inline TryWith: - comp: Cancellable<'T> * [] handler: (exn -> Cancellable<'T>) -> Cancellable<'T> - - member inline Using: - resource: 'Resource MaybeNull * [] comp: ('Resource MaybeNull -> Cancellable<'T>) -> - Cancellable<'T> - when 'Resource :> IDisposable and 'Resource: not struct and 'Resource: not null - - member inline Zero: unit -> Cancellable - -[] -module internal CancellableAutoOpens = - val cancellable: CancellableBuilder From fecd921f056cd4532daa4a55c132d86d0da952d6 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 13:53:18 +0200 Subject: [PATCH 07/48] wip --- src/Compiler/Checking/CheckDeclarations.fs | 58 ++++++++++------------ src/Compiler/Driver/ParseAndCheckInputs.fs | 4 +- 2 files changed, 27 insertions(+), 35 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 9f8d035128..719063033b 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5021,7 +5021,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE return env - with RecoverableException exn -> + with exn -> errorRecovery exn endm return env } @@ -5044,7 +5044,13 @@ and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = } and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = - Cancellable.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs + async2 { + match defs with + | [] -> return env + | def :: rest -> + let! env = TcSignatureElementNonMutRec cenv parent typeNames endm env def + return! TcSignatureElementsNonMutRec cenv parent typeNames endm env rest + } and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (defs: SynModuleSigDecl list) = async2 { @@ -5493,20 +5499,17 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem return (defns, [], topAttrs), env, envAtEnd - with RecoverableException exn -> + with exn -> errorRecovery exn synDecl.Range return ([], [], []), env, env } /// The non-mutually recursive case for a sequence of declarations -and [] TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) (ct: CancellationToken) = - - if ct.IsCancellationRequested then - ValueOrCancelled.Cancelled(OperationCanceledException ct) - else +and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) = + async2 { match moreDefs with | [] -> - ValueOrCancelled.Value (List.rev defsSoFar, envAtEnd) + return List.rev defsSoFar, envAtEnd | firstDef :: otherDefs -> // Lookahead one to find out the scope of the next declaration. let scopem = @@ -5515,14 +5518,9 @@ and [] TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm else unionRanges (List.head otherDefs).Range endm - let result = Cancellable.run ct (TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef |> cenv.stackGuard.GuardCancellable) - - match result with - | ValueOrCancelled.Cancelled x -> - ValueOrCancelled.Cancelled x - | ValueOrCancelled.Value(firstDef, env, envAtEnd) -> - TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ((firstDef :: defsSoFar), env, envAtEnd) otherDefs ct - + let! firstDef, env, envAtEnd = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef + return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ((firstDef :: defsSoFar), env, envAtEnd) otherDefs + } and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 synModuleDecls = async2 { @@ -5547,21 +5545,15 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 return (moduleContents, topAttrsNew, envAtEnd) | None -> - let! ct = Cancellable.token () - let result = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) synModuleDecls ct - - match result with - | ValueOrCancelled.Value(compiledDefs, envAtEnd) -> - // Apply the functions for each declaration to build the overall expression-builder - let moduleDefs = List.collect p13 compiledDefs - let moduleDefs = match openDecls0 with [] -> moduleDefs | _ -> TMDefOpens openDecls0 :: moduleDefs - let moduleContents = TMDefs moduleDefs - - // Collect up the attributes that are global to the file - let topAttrsNew = List.collect p33 compiledDefs - return (moduleContents, topAttrsNew, envAtEnd) - | ValueOrCancelled.Cancelled x -> - return! Cancellable(fun _ -> ValueOrCancelled.Cancelled x) + let! compiledDefs, envAtEnd = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) synModuleDecls + // Apply the functions for each declaration to build the overall expression-builder + let moduleDefs = List.collect p13 compiledDefs + let moduleDefs = match openDecls0 with [] -> moduleDefs | _ -> TMDefOpens openDecls0 :: moduleDefs + let moduleContents = TMDefs moduleDefs + + // Collect up the attributes that are global to the file + let topAttrsNew = List.collect p33 compiledDefs + return (moduleContents, topAttrsNew, envAtEnd) } @@ -5949,7 +5941,7 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin try sigFileType |> IterTyconsOfModuleOrNamespaceType (fun tycon -> FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv, tycon)) - with RecoverableException exn -> errorRecovery exn sigFile.QualifiedName.Range + with exn -> errorRecovery exn sigFile.QualifiedName.Range UpdatePrettyTyparNames.updateModuleOrNamespaceType sigFileType diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 5b9a156ec6..ab15cee94a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1355,7 +1355,7 @@ let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcG return! CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input) } - |> Cancellable.runWithoutCancellation + |> Async2.runWithoutCancellation /// Finish checking multiple files (or one interactive entry into F# Interactive) let CheckMultipleInputsFinish (results, tcState: TcState) = @@ -1833,7 +1833,7 @@ let CheckMultipleInputsUsingGraphMode node (checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, currentTcState, input, false) } - |> Cancellable.runWithoutCancellation + |> Async2.runWithoutCancellation Finisher( node, From f14b126af0c0ed0aa0bdc69baa5e42ea8218ad4a Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 13:54:48 +0200 Subject: [PATCH 08/48] wip --- src/Compiler/Checking/CheckDeclarations.fs | 3 --- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 ---- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 -- 3 files changed, 9 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 719063033b..fe45d5f8ab 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5377,7 +5377,6 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // Now typecheck. let! moduleContents, topAttrsNew, envAtEnd = TcModuleOrNamespaceElements cenv (Parent (mkLocalModuleRef moduleEntity)) endm envForModule xml None [] moduleDefs - |> cenv.stackGuard.GuardCancellable // Get the inferred type of the decls and record it in the modul. moduleEntity.entity_modul_type <- MaybeLazy.Strict moduleTyAcc.Value @@ -5469,7 +5468,6 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem let! moduleContents, topAttrs, envAtEnd = TcModuleOrNamespaceElements cenv parent endm envNS xml mutRecNSInfo [] defs - |> cenv.stackGuard.GuardCancellable MutRecBindingChecking.TcMutRecDefns_UpdateNSContents nsInfo let env, openDecls = @@ -5790,7 +5788,6 @@ let CheckOneImplFile let defs = [ for x in implFileFrags -> SynModuleDecl.NamespaceFragment x ] let! moduleContents, topAttrs, envAtEnd = TcModuleOrNamespaceElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None openDecls0 defs - |> cenv.stackGuard.GuardCancellable let implFileTypePriorToSig = moduleTyAcc.Value diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index a7316ab972..1ef603a2a9 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -909,10 +909,6 @@ type StackGuard(maxDepth: int, name: string) = finally depth <- depth - 1 - [] - member x.GuardCancellable(original: Async2<'T>) = - Cancellable(fun ct -> x.Guard(fun () -> Cancellable.run ct original)) - static member val DefaultDepth = #if DEBUG GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50 diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 2a7b041119..f545babce8 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -470,8 +470,6 @@ type StackGuard = [] line: int -> 'T - member GuardCancellable: Internal.Utilities.Library.Async2<'T> -> Internal.Utilities.Library.Async2<'T> - static member GetDepthOption: string -> int /// This represents the global state established as each task function runs as part of the build. From 9127783e3bcae7bfbd5b332762944827faa6d891 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 16:28:43 +0200 Subject: [PATCH 09/48] fix callsites --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Interactive/fsi.fs | 2 +- src/Compiler/Service/BackgroundCompiler.fs | 8 ++++---- src/Compiler/Service/FSharpCheckerResults.fs | 6 +++--- src/Compiler/Service/IncrementalBuild.fs | 2 +- src/Compiler/Service/TransparentCompiler.fs | 6 +++--- 6 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index fe45d5f8ab..e6525223fc 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4870,7 +4870,7 @@ module TcDeclarations = //------------------------------------------------------------------------- // Bind module types //------------------------------------------------------------------------- - +#nowarn 3511 let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async2 = async2 { let g = cenv.g diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 8b09f86fb4..ed1143d386 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4797,7 +4797,7 @@ type FsiEvaluationSession member _.ParseAndCheckInteraction(code) = fsiInteractionProcessor.ParseAndCheckInteraction(legacyReferenceResolver, fsiInteractionProcessor.CurrentState, code) - |> Cancellable.runWithoutCancellation + |> Async2.runWithoutCancellation member _.InteractiveChecker = checker diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index cf6cd09931..a728821051 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -343,7 +343,7 @@ type internal BackgroundCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Cancellable.toAsync + |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -358,7 +358,7 @@ type internal BackgroundCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Cancellable.toAsync + |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -745,7 +745,7 @@ type internal BackgroundCompiler keepAssemblyContents, suggestNamesForErrors ) - |> Cancellable.toAsync + |> Async2.toAsync GraphNode.SetPreferredUILang tcConfig.preferredUiLang return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp) @@ -1377,7 +1377,7 @@ type internal BackgroundCompiler return options, (diags @ diagnostics.Diagnostics) } - |> Cancellable.toAsync + |> Async2.toAsync member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index df8538562b..de6c9f4801 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -88,7 +88,7 @@ type DelayedILModuleReader = match box this.result with | null -> async2 { - let! ct = Cancellable.token () + let ct = Async2.Token return lock this.gate (fun () -> @@ -118,7 +118,7 @@ type DelayedILModuleReader = None | _ -> Some this.result) } - | _ -> cancellable.Return(Some this.result) + | _ -> async2 { return Some this.result } [] type FSharpReferencedProject = @@ -3931,7 +3931,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let! ct = Cancellable.token () + let ct = Async2.Token let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile ( diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 6db19653f9..cf171e78f0 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -272,7 +272,7 @@ type BoundModel private ( None, TcResultsSink.WithSink sink, prevTcInfo.tcState, input ) - |> Cancellable.toAsync + |> Async2.toAsync fileChecked.Trigger fileName diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 1525e75e2f..f50262a27d 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -784,7 +784,7 @@ type internal TransparentCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Cancellable.toAsync + |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -799,7 +799,7 @@ type internal TransparentCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Cancellable.toAsync + |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -1431,7 +1431,7 @@ type internal TransparentCompiler prevTcInfo.tcState, input, true) - |> Cancellable.toAsync + |> Async2.toAsync //fileChecked.Trigger fileName From 9ae962ad8361a48682413a2ddf13e7d6b0322509 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 16:29:56 +0200 Subject: [PATCH 10/48] add InlineIfLambda to fix pass2 duplicate method error during writing binary (FS2014) --- src/Compiler/Utilities/Async2.fs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 29a3a3cdc0..1b0b7a4615 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -116,8 +116,8 @@ module internal Async2Implementation = [] type internal Async2<'T> (start: bool -> Task<'T>) = - member _.Start() = start false - member _.GetAwaiter() = + member inline _.Start() = start false + member inline _.GetAwaiter() = let hijack = BindContext.IncrementBindCount() (start hijack).GetAwaiter() @@ -196,7 +196,7 @@ module internal Async2Implementation = ResumableCode.While(condition, throwIfCancellationRequested body) member inline _.TryWith - (body: Async2Code<'TOverall, 'T>, catch: exn -> Async2Code<'TOverall, 'T>) + (body: Async2Code<'TOverall, 'T>, [] catch: exn -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = ResumableCode.TryWith(body, filterCancellation catch) @@ -215,11 +215,11 @@ module internal Async2Implementation = : Async2Code<'TOverall, 'T> = ResumableCode.Using(resource, body) - member inline _.For(sequence: seq<'T>, body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = + member inline _.For(sequence: seq<'T>, [] body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) [] - static member inline BindDynamic(sm: byref>, awaiter, continuation: _ -> Async2Code<_, _>) = + static member inline BindDynamic(sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) = if Awaiter.isCompleted awaiter then (Awaiter.getResult awaiter |> continuation).Invoke(&sm) else @@ -232,7 +232,7 @@ module internal Async2Implementation = [] member inline _.Bind - (awaiter, continuation: 'U -> Async2Code<'Data, 'T>) + (awaiter, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = Async2Code(fun sm -> if __useResumableCode then @@ -375,3 +375,5 @@ module internal Async2 = let startAsTask (code: Async2<'t>) = code.Start() let runWithoutCancellation code = run CancellationToken.None code + + let toAsync (code: Async2<_>) = startAsTask code |> Async.AwaitTask From 4ebec4777bbcd8c05273aabd64beeb4c64a2984f Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 19:11:04 +0200 Subject: [PATCH 11/48] wip --- src/Compiler/Service/BackgroundCompiler.fs | 2 +- src/Compiler/Service/ServiceAnalysis.fs | 2 +- src/Compiler/Service/TransparentCompiler.fs | 10 ++-- src/Compiler/Utilities/Async2.fs | 21 ++++++-- src/Compiler/Utilities/Cancellable.fs | 49 ++----------------- src/Compiler/Utilities/Cancellable.fsi | 9 ---- .../ModuleReaderCancellationTests.fs | 2 +- 7 files changed, 29 insertions(+), 66 deletions(-) diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index a728821051..867f4219d6 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -503,7 +503,7 @@ type internal BackgroundCompiler let getOrCreateBuilder (options, userOpName) : Async = async { - use! _holder = Cancellable.UseToken() + use! _holder = Async2.UseTokenAsync () match tryGetBuilder options with | Some getBuilder -> diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 6455d9f0ff..4ed47613e5 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -302,7 +302,7 @@ module UnusedOpens = /// Async to allow cancellation. let getUnusedOpens (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) : Async = async { - use! _holder = Cancellable.UseToken() + use! _holder = Async2.UseTokenAsync () if checkFileResults.OpenDeclarations.Length = 0 then return [] diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index f50262a27d..fea4a02f62 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1608,7 +1608,7 @@ type internal TransparentCompiler caches.ParseAndCheckFileInProject.Get( projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, async { - use! _holder = Cancellable.UseToken() + use! _holder = Async2.UseTokenAsync () use _ = Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] @@ -1876,7 +1876,7 @@ type internal TransparentCompiler Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) |] - use! _holder = Cancellable.UseToken() + use! _holder = Async2.UseTokenAsync () try @@ -1924,7 +1924,7 @@ type internal TransparentCompiler caches.ParseAndCheckProject.Get( projectSnapshot.FullKey, async { - use! _holder = Cancellable.UseToken() + use! _holder = Async2.UseTokenAsync () match! ComputeBootstrapInfo projectSnapshot with | None, creationDiags -> @@ -1998,8 +1998,8 @@ type internal TransparentCompiler let tryGetSink (fileName: string) (projectSnapshot: ProjectSnapshot) = async { - use! _holder = Cancellable.UseToken() - + use! _holder = Async2.UseTokenAsync () + match! ComputeBootstrapInfo projectSnapshot with | None, _ -> return None | Some bootstrapInfo, _creationDiags -> diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 1b0b7a4615..9e09016ac8 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -6,9 +6,22 @@ open System.Threading.Tasks #nowarn 3513 -type Async2 = +type internal Async2 = static let token = AsyncLocal() - static member UseToken ct = token.Value <- ct + static member UseToken ct = + let old = token.Value + token.Value <- ct + { new IDisposable with + member _.Dispose() = token.Value <- old } + + + static member UseTokenAsync () = + async { + let! ct = Async.CancellationToken + let old = token.Value + token.Value <- ct + return { new IDisposable with member _.Dispose() = token.Value <- old } + } static member val Token = token.Value module internal Async2Implementation = @@ -85,7 +98,7 @@ module internal Async2Implementation = module BindContext = [] - let bindLimit = 100 + let bindLimit = 50 let bindCount = new ThreadLocal() @@ -366,7 +379,7 @@ module internal Async2 = open Async2Implementation let run ct (code: Async2<'t>) = - Async2.UseToken ct + use _ = Async2.UseToken ct if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then code.Start().GetAwaiter().GetResult() else diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index f1788f6aa1..33b8448688 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -1,52 +1,11 @@ namespace FSharp.Compiler -open System +open Internal.Utilities.Library open System.Threading -// This code provides two methods for handling cancellation in synchronous code: -// 1. Explicitly, by calling Cancellable.CheckAndThrow(). -// 2. Implicitly, by wrapping the code in a cancellable computation. -// The cancellable computation propagates the CancellationToken and checks for cancellation implicitly. -// When it is impractical to use the cancellable computation, such as in deeply nested functions, Cancellable.CheckAndThrow() can be used. -// It checks a CancellationToken local to the current async execution context, held in AsyncLocal. -// Before calling Cancellable.CheckAndThrow(), this token must be set. -// The token is guaranteed to be set during execution of cancellable computation. -// Otherwise, it can be passed explicitly from the ambient async computation using Cancellable.UseToken(). - [] type Cancellable = - static let tokenHolder = AsyncLocal() - - static let guard = - String.IsNullOrWhiteSpace(Environment.GetEnvironmentVariable("DISABLE_CHECKANDTHROW_ASSERT")) - - static let ensureToken msg = - tokenHolder.Value - |> ValueOption.defaultWith (fun () -> if guard then failwith msg else CancellationToken.None) - - static member HasCancellationToken = tokenHolder.Value.IsSome - - static member Token = ensureToken "Token not available outside of Cancellable computation." - - static member UseToken() = - async { - let! ct = Async.CancellationToken - return Cancellable.UsingToken ct - } - - static member UsingToken(ct) = - let oldCt = tokenHolder.Value - tokenHolder.Value <- ValueSome ct - - { new IDisposable with - member _.Dispose() = tokenHolder.Value <- oldCt - } - static member CheckAndThrow() = - let token = ensureToken "CheckAndThrow invoked outside of Cancellable computation." - token.ThrowIfCancellationRequested() - - static member TryCheckAndThrow() = - match tokenHolder.Value with - | ValueNone -> () - | ValueSome token -> token.ThrowIfCancellationRequested() + // If we're not inside an async computation, the ambient cancellation token will be CancellationToken.None and nothing will happen + // otherwise, if we are inside an async computation, this will throw. + Async2.Token.ThrowIfCancellationRequested() diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 880a31199f..ea928cd075 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -1,14 +1,5 @@ namespace FSharp.Compiler -open System -open System.Threading - [] type Cancellable = - static member internal UseToken: unit -> Async - - static member HasCancellationToken: bool - static member Token: CancellationToken - static member CheckAndThrow: unit -> unit - static member TryCheckAndThrow: unit -> unit diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index f307586cd5..e76761f01e 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -150,7 +150,7 @@ let parseAndCheck path source options = | _, FSharpCheckFileAnswer.Aborted -> None | _, FSharpCheckFileAnswer.Succeeded results -> Some results - Cancellable.HasCancellationToken |> shouldEqual false + Async2.Token |> shouldEqual CancellationToken.None result with :? OperationCanceledException -> From 097c0a3c77dc7ee796d5f012e49f04e750645547 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 20:51:27 +0200 Subject: [PATCH 12/48] fix --- src/Compiler/Utilities/Async2.fs | 28 ++++++++++--------- .../ModuleReaderCancellationTests.fs | 5 ---- 2 files changed, 15 insertions(+), 18 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 9e09016ac8..26cff28ca5 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -89,13 +89,11 @@ module internal Async2Implementation = interface ICriticalNotifyCompletion with member _.OnCompleted(continuation) = set continuation member _.UnsafeOnCompleted(continuation) = set continuation + + member this.Ref : ICriticalNotifyCompletion ref = ref this static member Current = holder.Value - module Trampoline = - let Awaiter : ICriticalNotifyCompletion = Trampoline.Current - let AwaiterRef = ref Awaiter - module BindContext = [] let bindLimit = 50 @@ -175,6 +173,7 @@ module internal Async2Implementation = type DynamicContinuation = | Stop | Immediate + | Bounce | Await of ICriticalNotifyCompletion let inline yieldOnBindLimit () = @@ -182,7 +181,7 @@ module internal Async2Implementation = if sm.Data.Hijack then let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) if not __stack_yield_fin then - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(Trampoline.AwaiterRef, &sm) + sm.Data.MethodBuilder.AwaitOnCompleted(Trampoline.Current.Ref, &sm) __stack_yield_fin else true @@ -269,32 +268,31 @@ module internal Async2Implementation = static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) - let resumptionInfo () = + let resumptionInfo hijack = let mutable state = InitialYield + let bounceOrImmediate = if hijack then Bounce else Immediate { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc) with member info.MoveNext(sm) = let mutable continuation = Stop - let hijackCheck = if sm.Data.Hijack then Await Trampoline.Awaiter else Immediate - let current = state match current with | InitialYield -> state <- Running - continuation <- hijackCheck + continuation <- bounceOrImmediate | Running -> try let step = info.ResumptionFunc.Invoke(&sm) if step then state <- SetResult - continuation <- hijackCheck + continuation <- bounceOrImmediate else match info.ResumptionData with | :? ICriticalNotifyCompletion as awaiter -> continuation <- Await awaiter | _ -> failwith "invalid awaiter" with exn -> state <- SetException (ExceptionCache.CaptureOrRetrieve exn) - continuation <- hijackCheck + continuation <- bounceOrImmediate | SetResult -> sm.Data.MethodBuilder.SetResult sm.Data.Result | SetException edi -> sm.Data.MethodBuilder.SetException(edi.SourceException) @@ -303,6 +301,11 @@ module internal Async2Implementation = sm.ResumptionDynamicInfo.ResumptionData <- null let mutable awaiter = awaiter sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + | Bounce -> + sm.Data.MethodBuilder.AwaitOnCompleted( + Trampoline.Current.Ref, + &sm + ) | Immediate -> info.MoveNext &sm | Stop -> () @@ -312,9 +315,8 @@ module internal Async2Implementation = Async2(fun hijack -> let mutable copy = Async2StateMachine() - copy.ResumptionDynamicInfo <- resumptionInfo () + copy.ResumptionDynamicInfo <- resumptionInfo hijack copy.Data <- Async2Data() - copy.Data.Hijack <- hijack copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index e76761f01e..d8988c1099 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -173,11 +173,6 @@ open Ns1.Ns2 let t: T = T() """ - -[] -let ``CheckAndThrow is not allowed to throw outside of cancellable`` () = - Assert.Throws(fun () -> Cancellable.CheckAndThrow()) - [] let ``Type defs 01 - assembly import`` () = let source = source1 From f985734f32f7a520bfb39435a87f14823bebf196 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 22:26:35 +0200 Subject: [PATCH 13/48] wip --- src/Compiler/Utilities/Async2.fs | 14 ++++++++++---- ...r.Service.SurfaceArea.netstandard20.release.bsl | 5 ----- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 26cff28ca5..e0893e64d8 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -59,6 +59,9 @@ module internal Async2Implementation = awaiter.UnsafeOnCompleted continuation type Trampoline private () = + + let failIfNot condition message = + if not condition then failwith message let ownerThreadId = Thread.CurrentThread.ManagedThreadId @@ -79,8 +82,8 @@ module internal Async2Implementation = running <- false let set action = - assert (Thread.CurrentThread.ManagedThreadId = ownerThreadId) - assert pending.IsNone + failIfNot (Thread.CurrentThread.ManagedThreadId = ownerThreadId) "Trampoline used from wrong thread" + failIfNot pending.IsNone "Trampoline used while already pending" if running then pending <- ValueSome action else @@ -96,7 +99,7 @@ module internal Async2Implementation = module BindContext = [] - let bindLimit = 50 + let bindLimit = 25 let bindCount = new ThreadLocal() @@ -127,7 +130,10 @@ module internal Async2Implementation = [] type internal Async2<'T> (start: bool -> Task<'T>) = - member inline _.Start() = start false + member inline _.Start() = + BindContext.IncrementBindCount() |> ignore + start false + member inline _.GetAwaiter() = let hijack = BindContext.IncrementBindCount() (start hijack).GetAwaiter() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index bc08c7fd0b..4a60d33db6 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -2011,12 +2011,7 @@ FSharp.Compiler.AbstractIL.ILBinaryReader: FSharp.Compiler.AbstractIL.ILBinaryRe FSharp.Compiler.AbstractIL.ILBinaryReader: FSharp.Compiler.AbstractIL.ILBinaryReader+MetadataOnlyFlag FSharp.Compiler.AbstractIL.ILBinaryReader: FSharp.Compiler.AbstractIL.ILBinaryReader+ReduceMemoryFlag FSharp.Compiler.AbstractIL.ILBinaryReader: FSharp.Compiler.AbstractIL.ILBinaryReader+Shim -FSharp.Compiler.Cancellable: Boolean HasCancellationToken -FSharp.Compiler.Cancellable: Boolean get_HasCancellationToken() -FSharp.Compiler.Cancellable: System.Threading.CancellationToken Token -FSharp.Compiler.Cancellable: System.Threading.CancellationToken get_Token() FSharp.Compiler.Cancellable: Void CheckAndThrow() -FSharp.Compiler.Cancellable: Void TryCheckAndThrow() FSharp.Compiler.CodeAnalysis.DelayedILModuleReader: System.String OutputFile FSharp.Compiler.CodeAnalysis.DelayedILModuleReader: System.String get_OutputFile() FSharp.Compiler.CodeAnalysis.DelayedILModuleReader: Void .ctor(System.String, Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Microsoft.FSharp.Core.FSharpOption`1[System.IO.Stream]]) From 4f816637e3edf71bfa7d942815ce409fb183e5ea Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 28 Aug 2025 23:24:01 +0200 Subject: [PATCH 14/48] wip --- src/Compiler/Service/BackgroundCompiler.fs | 2 +- src/Compiler/Service/ServiceAnalysis.fs | 2 +- src/Compiler/Service/TransparentCompiler.fs | 10 +- src/Compiler/Utilities/Async2.fs | 320 +++++++++++--------- 4 files changed, 180 insertions(+), 154 deletions(-) diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 867f4219d6..b6ffa72ea9 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -503,7 +503,7 @@ type internal BackgroundCompiler let getOrCreateBuilder (options, userOpName) : Async = async { - use! _holder = Async2.UseTokenAsync () + use! _holder = Async2.UseTokenAsync() match tryGetBuilder options with | Some getBuilder -> diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 4ed47613e5..43f9110085 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -302,7 +302,7 @@ module UnusedOpens = /// Async to allow cancellation. let getUnusedOpens (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) : Async = async { - use! _holder = Async2.UseTokenAsync () + use! _holder = Async2.UseTokenAsync() if checkFileResults.OpenDeclarations.Length = 0 then return [] diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index fea4a02f62..8472c47af7 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1608,7 +1608,7 @@ type internal TransparentCompiler caches.ParseAndCheckFileInProject.Get( projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, async { - use! _holder = Async2.UseTokenAsync () + use! _holder = Async2.UseTokenAsync() use _ = Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] @@ -1876,7 +1876,7 @@ type internal TransparentCompiler Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) |] - use! _holder = Async2.UseTokenAsync () + use! _holder = Async2.UseTokenAsync() try @@ -1924,7 +1924,7 @@ type internal TransparentCompiler caches.ParseAndCheckProject.Get( projectSnapshot.FullKey, async { - use! _holder = Async2.UseTokenAsync () + use! _holder = Async2.UseTokenAsync() match! ComputeBootstrapInfo projectSnapshot with | None, creationDiags -> @@ -1998,8 +1998,8 @@ type internal TransparentCompiler let tryGetSink (fileName: string) (projectSnapshot: ProjectSnapshot) = async { - use! _holder = Async2.UseTokenAsync () - + use! _holder = Async2.UseTokenAsync() + match! ComputeBootstrapInfo projectSnapshot with | None, _ -> return None | Some bootstrapInfo, _creationDiags -> diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index e0893e64d8..b9c8e6bc9d 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -8,20 +8,27 @@ open System.Threading.Tasks type internal Async2 = static let token = AsyncLocal() + static member UseToken ct = let old = token.Value token.Value <- ct + { new IDisposable with - member _.Dispose() = token.Value <- old } + member _.Dispose() = token.Value <- old + } - - static member UseTokenAsync () = + static member UseTokenAsync() = async { let! ct = Async.CancellationToken let old = token.Value token.Value <- ct - return { new IDisposable with member _.Dispose() = token.Value <- old } + + return + { new IDisposable with + member _.Dispose() = token.Value <- old + } } + static member val Token = token.Value module internal Async2Implementation = @@ -38,123 +45,122 @@ module internal Async2Implementation = and 'Awaiter: (member get_IsCompleted: unit -> bool) and 'Awaiter: (member GetResult: unit -> 'TResult)> = 'Awaiter - type Awaitable<'Awaitable, 'Awaiter, 'TResult - when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable + type Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable module Awaiter = - let inline isCompleted (awaiter: ^Awaiter) : bool - when ^Awaiter : (member get_IsCompleted : unit -> bool) = - awaiter.get_IsCompleted() + let inline isCompleted (awaiter: ^Awaiter) : bool when ^Awaiter: (member get_IsCompleted: unit -> bool) = awaiter.get_IsCompleted () - let inline getResult (awaiter: ^Awaiter) : ^TResult - when ^Awaiter : (member GetResult : unit -> ^TResult) = - awaiter.GetResult() + let inline getResult (awaiter: ^Awaiter) : ^TResult when ^Awaiter: (member GetResult: unit -> ^TResult) = awaiter.GetResult() - let inline onCompleted (awaiter: ^Awaiter) (continuation: Action) : unit - when ^Awaiter :> INotifyCompletion = - awaiter.OnCompleted continuation + let inline onCompleted (awaiter: ^Awaiter) (continuation: Action) : unit when ^Awaiter :> INotifyCompletion = + awaiter.OnCompleted continuation - let inline unsafeOnCompleted (awaiter: ^Awaiter) (continuation: Action) : unit - when ^Awaiter :> ICriticalNotifyCompletion = - awaiter.UnsafeOnCompleted continuation + let inline unsafeOnCompleted (awaiter: ^Awaiter) (continuation: Action) : unit when ^Awaiter :> ICriticalNotifyCompletion = + awaiter.UnsafeOnCompleted continuation type Trampoline private () = let failIfNot condition message = - if not condition then failwith message - + if not condition then + failwith message + let ownerThreadId = Thread.CurrentThread.ManagedThreadId - + static let holder = new ThreadLocal<_>(fun () -> Trampoline()) - - let mutable pending : Action voption = ValueNone + + let mutable pending: Action voption = ValueNone let mutable running = false - + let start (action: Action) = - try + try running <- true action.Invoke() + while pending.IsSome do let next = pending.Value pending <- ValueNone next.Invoke() finally running <- false - + let set action = failIfNot (Thread.CurrentThread.ManagedThreadId = ownerThreadId) "Trampoline used from wrong thread" failIfNot pending.IsNone "Trampoline used while already pending" + if running then pending <- ValueSome action else start action - + interface ICriticalNotifyCompletion with member _.OnCompleted(continuation) = set continuation member _.UnsafeOnCompleted(continuation) = set continuation - member this.Ref : ICriticalNotifyCompletion ref = ref this - + member this.Ref: ICriticalNotifyCompletion ref = ref this + static member Current = holder.Value - + module BindContext = [] - let bindLimit = 25 - + let bindLimit = 200 + let bindCount = new ThreadLocal() - + + let inline ResetBindCount () = bindCount.Value <- 0 + let inline IncrementBindCount () = bindCount.Value <- bindCount.Value + 1 bindCount.Value % bindLimit = 0 - + module ExceptionCache = let store = ConditionalWeakTable() - + let inline CaptureOrRetrieve (exn: exn) = match store.TryGetValue exn with | true, edi when edi.SourceException = exn -> edi | _ -> let edi = ExceptionDispatchInfo.Capture exn - - try store.Add(exn, edi) with _ -> () - + + try + store.Add(exn, edi) + with _ -> + () + edi - - let inline Throw(exn: exn) = + + let inline Throw (exn: exn) = let edi = CaptureOrRetrieve exn edi.Throw() Unchecked.defaultof<_> - - let inline GetResultOrThrow awaiter = try Awaiter.getResult awaiter with exn -> Throw exn + + let inline GetResultOrThrow awaiter = + try + Awaiter.getResult awaiter + with exn -> + Throw exn [] - type internal Async2<'T> (start: bool -> Task<'T>) = - - member inline _.Start() = - BindContext.IncrementBindCount() |> ignore - start false - - member inline _.GetAwaiter() = - let hijack = BindContext.IncrementBindCount() - (start hijack).GetAwaiter() - + type internal Async2<'T>(start: unit -> Task<'T>) = + + member inline _.Start() = start () + [] type Async2Data<'t> = [] val mutable Result: 't - + [] val mutable MethodBuilder: AsyncTaskMethodBuilder<'t> - + [] val mutable Hijack: bool - + type Async2StateMachine<'TOverall> = ResumableStateMachine> type IAsync2StateMachine<'TOverall> = IResumableStateMachine> type Async2ResumptionFunc<'TOverall> = ResumptionFunc> type Async2ResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> - type Async2Code<'TOverall, 'T> = ResumableCode, 'T> - + type Async2Code<'TOverall, 'T> = ResumableCode, 'T> + [] module Async2Code = let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = @@ -162,62 +168,62 @@ module internal Async2Implementation = match exn with | :? OperationCanceledException as oce when oce.CancellationToken = Async2.Token -> raise exn | _ -> (catch exn).Invoke(&sm)) - + let inline throwIfCancellationRequested (code: Async2Code<_, _>) = Async2Code(fun sm -> Async2.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) - + [] type DynamicState = | InitialYield | Running | SetResult | SetException of ExceptionDispatchInfo - + [] type DynamicContinuation = | Stop | Immediate | Bounce | Await of ICriticalNotifyCompletion - + let inline yieldOnBindLimit () = Async2Code<_, _>(fun sm -> - if sm.Data.Hijack then + if BindContext.IncrementBindCount() then let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + if not __stack_yield_fin then sm.Data.MethodBuilder.AwaitOnCompleted(Trampoline.Current.Ref, &sm) + __stack_yield_fin else - true - ) - + true) + type Async2Builder() = - + member inline _.Delay(generator: unit -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = ResumableCode.Delay(fun () -> generator () |> throwIfCancellationRequested) - + [] member inline _.Zero() : Async2Code<'TOverall, unit> = ResumableCode.Zero() - - member inline _.Return(value: 'T) = Async2Code(fun sm -> sm.Data.Result <- value; true) - - member inline _.Combine - (code1: Async2Code<'TOverall, unit>, code2: Async2Code<'TOverall, 'T>) - : Async2Code<'TOverall, 'T> = + + member inline _.Return(value: 'T) = + Async2Code(fun sm -> + sm.Data.Result <- value + true) + + member inline _.Combine(code1: Async2Code<'TOverall, unit>, code2: Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = ResumableCode.Combine(code1, code2) - - member inline _.While - ([] condition: unit -> bool, body: Async2Code<'TOverall, unit>) - : Async2Code<'TOverall, unit> = + + member inline _.While([] condition: unit -> bool, body: Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = ResumableCode.While(condition, throwIfCancellationRequested body) - + member inline _.TryWith (body: Async2Code<'TOverall, 'T>, [] catch: exn -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = ResumableCode.TryWith(body, filterCancellation catch) - + member inline _.TryFinally (body: Async2Code<'TOverall, 'T>, [] compensation: unit -> unit) : Async2Code<'TOverall, 'T> = @@ -227,154 +233,162 @@ module internal Async2Implementation = compensation () true) ) - + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable | null> (resource: 'Resource, body: 'Resource -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = ResumableCode.Using(resource, body) - + member inline _.For(sequence: seq<'T>, [] body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) - + [] - static member inline BindDynamic(sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) = + static member inline BindDynamic + (sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) + = if Awaiter.isCompleted awaiter then (Awaiter.getResult awaiter |> continuation).Invoke(&sm) else - let resumptionFunc = Async2ResumptionFunc(fun sm -> - let result = ExceptionCache.GetResultOrThrow awaiter - (continuation result).Invoke(&sm)) + let resumptionFunc = + Async2ResumptionFunc(fun sm -> + let result = ExceptionCache.GetResultOrThrow awaiter + (continuation result).Invoke(&sm)) + sm.ResumptionDynamicInfo.ResumptionFunc <- resumptionFunc sm.ResumptionDynamicInfo.ResumptionData <- awaiter :> ICriticalNotifyCompletion false - + [] - member inline _.Bind - (awaiter, [] continuation: 'U -> Async2Code<'Data, 'T>) - : Async2Code<'Data, 'T> = - Async2Code(fun sm -> - if __useResumableCode then - if Awaiter.isCompleted awaiter then + member inline _.Bind(awaiter, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = + Async2Code(fun sm -> + if __useResumableCode then + if Awaiter.isCompleted awaiter then + continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) + else + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + + if __stack_yield_fin then continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) else - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - if __stack_yield_fin then - continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) - else - let mutable __stack_awaiter = awaiter - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&__stack_awaiter, &sm) - false - else - Async2Builder.BindDynamic(&sm, awaiter, continuation) - ) - + let mutable __stack_awaiter = awaiter + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&__stack_awaiter, &sm) + false + else + Async2Builder.BindDynamic(&sm, awaiter, continuation)) + [] member inline this.ReturnFrom(awaiter) : Async2Code<'T, 'T> = this.Bind(awaiter, this.Return) - + static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) - - let resumptionInfo hijack = + + let resumptionInfo () = let mutable state = InitialYield - let bounceOrImmediate = if hijack then Bounce else Immediate + + let bounceOrImmediate () = + if BindContext.IncrementBindCount() then + Bounce + else + Immediate + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc) with member info.MoveNext(sm) = let mutable continuation = Stop - + let current = state + match current with | InitialYield -> state <- Running - continuation <- bounceOrImmediate + continuation <- bounceOrImmediate () | Running -> try - let step = info.ResumptionFunc.Invoke(&sm) + let step = info.ResumptionFunc.Invoke(&sm) + if step then - state <- SetResult - continuation <- bounceOrImmediate + state <- SetResult + continuation <- bounceOrImmediate () else match info.ResumptionData with | :? ICriticalNotifyCompletion as awaiter -> continuation <- Await awaiter | _ -> failwith "invalid awaiter" with exn -> - state <- SetException (ExceptionCache.CaptureOrRetrieve exn) - continuation <- bounceOrImmediate + state <- SetException(ExceptionCache.CaptureOrRetrieve exn) + continuation <- bounceOrImmediate () | SetResult -> sm.Data.MethodBuilder.SetResult sm.Data.Result | SetException edi -> sm.Data.MethodBuilder.SetException(edi.SourceException) - + match continuation with | Await awaiter -> sm.ResumptionDynamicInfo.ResumptionData <- null let mutable awaiter = awaiter sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - | Bounce -> - sm.Data.MethodBuilder.AwaitOnCompleted( - Trampoline.Current.Ref, - &sm - ) + | Bounce -> sm.Data.MethodBuilder.AwaitOnCompleted(Trampoline.Current.Ref, &sm) | Immediate -> info.MoveNext &sm | Stop -> () - + member _.SetStateMachine(sm, state) = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2(fun hijack -> + Async2(fun () -> let mutable copy = Async2StateMachine() - copy.ResumptionDynamicInfo <- resumptionInfo hijack + copy.ResumptionDynamicInfo <- resumptionInfo () copy.Data <- Async2Data() copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) - + member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then __stateMachine, _> - + (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint let mutable error = ValueNone - + let __stack_go1 = yieldOnBindLimit().Invoke(&sm) + if __stack_go1 then try let __stack_code_fin = code.Invoke(&sm) + if __stack_code_fin then let __stack_go2 = yieldOnBindLimit().Invoke(&sm) + if __stack_go2 then sm.Data.MethodBuilder.SetResult(sm.Data.Result) with exn -> - error <- ValueSome (ExceptionCache.CaptureOrRetrieve exn) - + error <- ValueSome(ExceptionCache.CaptureOrRetrieve exn) + if error.IsSome then - let __stack_go2 = yieldOnBindLimit().Invoke(&sm) + let __stack_go2 = yieldOnBindLimit().Invoke(&sm) + if __stack_go2 then - sm.Data.MethodBuilder.SetException(error.Value.SourceException) - )) - + sm.Data.MethodBuilder.SetException(error.Value.SourceException))) + (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) - + (AfterCode<_, _>(fun sm -> let mutable copy = sm - Async2(fun hijack -> + + Async2(fun () -> copy.Data <- Async2Data() - copy.Data.Hijack <- hijack copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) - copy.Data.MethodBuilder.Task) - )) + copy.Data.MethodBuilder.Task))) else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code.GetAwaiter() - + member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() + [] module SourceExtensions = - type Async2Builder with + type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() member inline _.Source(task: Task) = task.GetAwaiter() - member inline _.Source(items: #seq<_>) : seq<_> = upcast items - + member inline _.Source(items: #seq<_>) : seq<_> = upcast items + [] module internal Async2AutoOpens = open Async2Implementation @@ -388,12 +402,24 @@ module internal Async2 = let run ct (code: Async2<'t>) = use _ = Async2.UseToken ct - if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then + + if + isNull SynchronizationContext.Current + && TaskScheduler.Current = TaskScheduler.Default + then + BindContext.ResetBindCount() code.Start().GetAwaiter().GetResult() - else - Task.Run<'t>(code.Start).GetAwaiter().GetResult() + else + Task + .Run<'t>(fun () -> + BindContext.ResetBindCount() + code.Start()) + .GetAwaiter() + .GetResult() - let startAsTask (code: Async2<'t>) = code.Start() + let startAsTask (code: Async2<'t>) = + BindContext.ResetBindCount() + code.Start() let runWithoutCancellation code = run CancellationToken.None code From c15cafed473c33689a4fab31adb1b02090ab35b8 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 29 Aug 2025 13:10:51 +0200 Subject: [PATCH 15/48] wip --- src/Compiler/Utilities/Async2.fs | 47 ++++++++++++++++---------------- 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index b9c8e6bc9d..85428bff01 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -100,9 +100,23 @@ module internal Async2Implementation = static member Current = holder.Value + [] + type DynamicContinuation = + | Stop + | Immediate + | Bounce + | Await of ICriticalNotifyCompletion + + [] + type DynamicState = + | InitialYield + | Running + | SetResult + | SetException of ExceptionDispatchInfo + module BindContext = [] - let bindLimit = 200 + let bindLimit = 100 let bindCount = new ThreadLocal() @@ -112,6 +126,9 @@ module internal Async2Implementation = bindCount.Value <- bindCount.Value + 1 bindCount.Value % bindLimit = 0 + let inline IncrementBindCountDynamic () = + if IncrementBindCount() then Bounce else Immediate + module ExceptionCache = let store = ConditionalWeakTable() @@ -174,20 +191,6 @@ module internal Async2Implementation = Async2.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) - [] - type DynamicState = - | InitialYield - | Running - | SetResult - | SetException of ExceptionDispatchInfo - - [] - type DynamicContinuation = - | Stop - | Immediate - | Bounce - | Await of ICriticalNotifyCompletion - let inline yieldOnBindLimit () = Async2Code<_, _>(fun sm -> if BindContext.IncrementBindCount() then @@ -285,12 +288,6 @@ module internal Async2Implementation = let resumptionInfo () = let mutable state = InitialYield - let bounceOrImmediate () = - if BindContext.IncrementBindCount() then - Bounce - else - Immediate - { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc) with member info.MoveNext(sm) = let mutable continuation = Stop @@ -300,24 +297,26 @@ module internal Async2Implementation = match current with | InitialYield -> state <- Running - continuation <- bounceOrImmediate () + continuation <- BindContext.IncrementBindCountDynamic() | Running -> try let step = info.ResumptionFunc.Invoke(&sm) if step then state <- SetResult - continuation <- bounceOrImmediate () + continuation <- BindContext.IncrementBindCountDynamic() else match info.ResumptionData with | :? ICriticalNotifyCompletion as awaiter -> continuation <- Await awaiter | _ -> failwith "invalid awaiter" with exn -> state <- SetException(ExceptionCache.CaptureOrRetrieve exn) - continuation <- bounceOrImmediate () + continuation <- BindContext.IncrementBindCountDynamic() | SetResult -> sm.Data.MethodBuilder.SetResult sm.Data.Result | SetException edi -> sm.Data.MethodBuilder.SetException(edi.SourceException) + let continuation = continuation + match continuation with | Await awaiter -> sm.ResumptionDynamicInfo.ResumptionData <- null From 0982cf8bf7e461b104e8ec04ba7d4fe104121875 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 1 Sep 2025 22:28:03 +0200 Subject: [PATCH 16/48] fix Source extensions --- src/Compiler/Utilities/Async2.fs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 85428bff01..357459e027 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -381,19 +381,17 @@ module internal Async2Implementation = member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() - [] - module SourceExtensions = - type Async2Builder with - member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() - member inline _.Source(task: Task) = task.GetAwaiter() - member inline _.Source(items: #seq<_>) : seq<_> = upcast items - [] module internal Async2AutoOpens = open Async2Implementation let async2 = Async2Builder() + type Async2Builder with + member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() + member inline _.Source(task: Task) = task.GetAwaiter() + member inline _.Source(items: #seq<_>) : seq<_> = upcast items + type Async2<'t> = Async2Implementation.Async2<'t> module internal Async2 = From da319d400464dc5a0e0ffbb91c1437831098e43e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 2 Sep 2025 13:12:28 +0200 Subject: [PATCH 17/48] wip --- src/Compiler/Utilities/Async2.fs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 357459e027..8fcf7d96ff 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -387,15 +387,27 @@ module internal Async2AutoOpens = let async2 = Async2Builder() +[] +module internal Async2LowPriority = + open Async2Implementation + type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() - member inline _.Source(task: Task) = task.GetAwaiter() + member inline _.Source(expr: Async<_>) = Async.StartAsTask(expr, cancellationToken = Async2.Token).GetAwaiter() member inline _.Source(items: #seq<_>) : seq<_> = upcast items -type Async2<'t> = Async2Implementation.Async2<'t> +[] +module internal Async2MediumPriority = + open Async2Implementation + type Async2Builder with + member inline _.Source(task: Task) = task.GetAwaiter() + member inline _.Source(task: Task<_>) = task.GetAwaiter() + +open Async2Implementation + +type internal Async2<'t> = Async2Implementation.Async2<'t> module internal Async2 = - open Async2Implementation let run ct (code: Async2<'t>) = use _ = Async2.UseToken ct From eb52129b45c25e4d539a1c7bd9ce3a2d3478a4c1 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 4 Sep 2025 10:08:14 +0200 Subject: [PATCH 18/48] wip --- src/Compiler/Service/FSharpCheckerResults.fs | 4 +- src/Compiler/Utilities/Async2.fs | 131 +++++++++++------- src/Compiler/Utilities/Cancellable.fs | 3 +- .../ModuleReaderCancellationTests.fs | 2 +- 4 files changed, 83 insertions(+), 57 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 732ce24bcc..7e46455a76 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -88,7 +88,7 @@ type DelayedILModuleReader = match box this.result with | null -> async2 { - let ct = Async2.Token + let ct = Async2.CancellationToken return lock this.gate (fun () -> @@ -3931,7 +3931,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let ct = Async2.Token + let ct = Async2.CancellationToken let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile ( diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 8fcf7d96ff..73e96a40bf 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -6,31 +6,6 @@ open System.Threading.Tasks #nowarn 3513 -type internal Async2 = - static let token = AsyncLocal() - - static member UseToken ct = - let old = token.Value - token.Value <- ct - - { new IDisposable with - member _.Dispose() = token.Value <- old - } - - static member UseTokenAsync() = - async { - let! ct = Async.CancellationToken - let old = token.Value - token.Value <- ct - - return - { new IDisposable with - member _.Dispose() = token.Value <- old - } - } - - static member val Token = token.Value - module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -39,6 +14,19 @@ module internal Async2Implementation = open System.Runtime.CompilerServices open System.Runtime.ExceptionServices + let failIfNot condition message = + if not condition then + failwith message + + [] + type Context = + { + Token: CancellationToken + IsNested: bool + } + + let currentContext = AsyncLocal() + /// A structure that looks like an Awaiter type Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion @@ -60,10 +48,6 @@ module internal Async2Implementation = type Trampoline private () = - let failIfNot condition message = - if not condition then - failwith message - let ownerThreadId = Thread.CurrentThread.ManagedThreadId static let holder = new ThreadLocal<_>(fun () -> Trampoline()) @@ -124,7 +108,12 @@ module internal Async2Implementation = let inline IncrementBindCount () = bindCount.Value <- bindCount.Value + 1 - bindCount.Value % bindLimit = 0 + + if bindCount.Value >= bindLimit then + ResetBindCount() + true + else + false let inline IncrementBindCountDynamic () = if IncrementBindCount() then Bounce else Immediate @@ -157,9 +146,23 @@ module internal Async2Implementation = Throw exn [] - type internal Async2<'T>(start: unit -> Task<'T>) = + type Async2<'T>(start: unit -> Task<'T>) = + + //static let tailCallSource = AsyncLocal voption>() - member inline _.Start() = start () + member _.startWithContext context = + let old = currentContext.Value + currentContext.Value <- context + + try + BindContext.ResetBindCount() + start () + finally + currentContext.Value <- old + + member _.StartBound() = + failIfNot currentContext.Value.IsNested "StartBound requires a nested context" + start () [] type Async2Data<'t> = @@ -169,9 +172,6 @@ module internal Async2Implementation = [] val mutable MethodBuilder: AsyncTaskMethodBuilder<'t> - [] - val mutable Hijack: bool - type Async2StateMachine<'TOverall> = ResumableStateMachine> type IAsync2StateMachine<'TOverall> = IResumableStateMachine> type Async2ResumptionFunc<'TOverall> = ResumptionFunc> @@ -183,12 +183,12 @@ module internal Async2Implementation = let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = Async2.Token -> raise exn + | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> raise exn | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: Async2Code<_, _>) = Async2Code(fun sm -> - Async2.Token.ThrowIfCancellationRequested() + currentContext.Value.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) let inline yieldOnBindLimit () = @@ -271,6 +271,7 @@ module internal Async2Implementation = let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) if __stack_yield_fin then + BindContext.ResetBindCount() continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) else let mutable __stack_awaiter = awaiter @@ -379,7 +380,7 @@ module internal Async2Implementation = else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() + member inline _.Source(code: Async2<_>) = code.StartBound().GetAwaiter() [] module internal Async2AutoOpens = @@ -393,43 +394,69 @@ module internal Async2LowPriority = type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() - member inline _.Source(expr: Async<_>) = Async.StartAsTask(expr, cancellationToken = Async2.Token).GetAwaiter() + + member inline _.Source(expr: Async<_>) = + Async.StartAsTask(expr, cancellationToken = currentContext.Value.Token).GetAwaiter() + member inline _.Source(items: #seq<_>) : seq<_> = upcast items [] module internal Async2MediumPriority = open Async2Implementation + type Async2Builder with - member inline _.Source(task: Task) = task.GetAwaiter() + member inline _.Source(task: Task) = task.GetAwaiter() member inline _.Source(task: Task<_>) = task.GetAwaiter() open Async2Implementation type internal Async2<'t> = Async2Implementation.Async2<'t> +type internal Async2 = + static member CancellationToken = currentContext.Value.Token + + static member UseTokenAsync() = + async { + let! ct = Async.CancellationToken + let old = currentContext.Value.Token + currentContext.Value <- { currentContext.Value with Token = ct } + + return + { new IDisposable with + member _.Dispose() = + currentContext.Value <- + { currentContext.Value with + Token = old + } + } + } + module internal Async2 = let run ct (code: Async2<'t>) = - use _ = Async2.UseToken ct + let context = { Token = ct; IsNested = true } if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - BindContext.ResetBindCount() - code.Start().GetAwaiter().GetResult() + code.startWithContext(context).GetAwaiter().GetResult() else - Task - .Run<'t>(fun () -> - BindContext.ResetBindCount() - code.Start()) - .GetAwaiter() - .GetResult() + Task.Run<'t>(fun () -> code.startWithContext (context)).GetAwaiter().GetResult() let startAsTask (code: Async2<'t>) = - BindContext.ResetBindCount() - code.Start() + let context = + { + Token = CancellationToken.None + IsNested = true + } + + code.startWithContext context let runWithoutCancellation code = run CancellationToken.None code - let toAsync (code: Async2<_>) = startAsTask code |> Async.AwaitTask + let toAsync (code: Async2<'t>) = + async { + let! ct = Async.CancellationToken + return run ct code + } diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 33b8448688..812db9e369 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -1,11 +1,10 @@ namespace FSharp.Compiler open Internal.Utilities.Library -open System.Threading [] type Cancellable = static member CheckAndThrow() = // If we're not inside an async computation, the ambient cancellation token will be CancellationToken.None and nothing will happen // otherwise, if we are inside an async computation, this will throw. - Async2.Token.ThrowIfCancellationRequested() + Async2.CancellationToken.ThrowIfCancellationRequested() diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index d8988c1099..9b04ad0984 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -150,7 +150,7 @@ let parseAndCheck path source options = | _, FSharpCheckFileAnswer.Aborted -> None | _, FSharpCheckFileAnswer.Succeeded results -> Some results - Async2.Token |> shouldEqual CancellationToken.None + Async2.CancellationToken |> shouldEqual CancellationToken.None result with :? OperationCanceledException -> From fb0d318fbe65f54db5dda7897e0ef57f5eb8419a Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 4 Sep 2025 18:26:16 +0200 Subject: [PATCH 19/48] wip --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fsi | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 +- src/Compiler/Facilities/BuildGraph.fs | 70 +- src/Compiler/Facilities/BuildGraph.fsi | 6 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 3 + src/Compiler/Facilities/DiagnosticsLogger.fsi | 4 + src/Compiler/Service/BackgroundCompiler.fs | 74 +- src/Compiler/Service/FSharpCheckerResults.fsi | 6 +- src/Compiler/Service/IncrementalBuild.fs | 103 +- src/Compiler/Utilities/Async2.fs | 71 +- .../BuildGraphTests.fs | 902 +++++++++--------- 13 files changed, 635 insertions(+), 620 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e6525223fc..eae9f43014 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4871,7 +4871,7 @@ module TcDeclarations = // Bind module types //------------------------------------------------------------------------- #nowarn 3511 -let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async2 = +let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: IAsync2 = async2 { let g = cenv.g try diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index 1a2be70f80..05f0a6f05b 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -60,7 +60,7 @@ val CheckOneImplFile: ModuleOrNamespaceType option * ParsedImplFileInput * FSharpDiagnosticOptions -> - Async2 + IAsync2 val CheckOneSigFile: TcGlobals * @@ -73,7 +73,7 @@ val CheckOneSigFile: FSharpDiagnosticOptions -> TcEnv -> ParsedSigFileInput -> - Async2 + IAsync2 exception NotUpperCaseConstructor of range: range diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index ab15cee94a..a395f4a3cc 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1225,7 +1225,7 @@ let CheckOneInput tcSink: TcResultsSink, tcState: TcState, input: ParsedInput - ) : Async2 = + ) : IAsync2 = async2 { try use _ = @@ -1445,7 +1445,7 @@ let CheckOneInputWithCallback _skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool ) - : Async2> = + : IAsync2> = async2 { try CheckSimulateException tcConfig diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 6233cd17c1..d22b6d40d2 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -180,7 +180,7 @@ val CheckOneInput: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Async2<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> + IAsync2<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> val CheckOneInputWithCallback: node: NodeToTypeCheck -> @@ -193,7 +193,7 @@ val CheckOneInputWithCallback: tcState: TcState * input: ParsedInput * _skipImplIfSigExists: bool -> - Async2> + IAsync2> val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -248,4 +248,4 @@ val CheckOneInputAndFinish: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Async2<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> + IAsync2<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index db77f52ea1..f2b5284b8e 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -5,6 +5,8 @@ module FSharp.Compiler.BuildGraph open System.Threading open System.Globalization +open Internal.Utilities.Library + [] module GraphNode = @@ -20,51 +22,42 @@ module GraphNode = | None -> () [] -type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T>, cachedResultNode: Async<'T>) = - - let mutable computation = computation +type GraphNode<'T> private (computation: IAsync2<'T>, cachedResult: ValueOption<'T>) = let mutable requestCount = 0 let mutable cachedResult = cachedResult - let mutable cachedResultNode: Async<'T> = cachedResultNode - - let isCachedResultNodeNotNull () = - not (obj.ReferenceEquals(cachedResultNode, null)) let semaphore = new SemaphoreSlim(1, 1) member _.GetOrComputeValue() = - // fast path - if isCachedResultNodeNotNull () then - cachedResultNode + async2 { + if cachedResult.IsSome then + return cachedResult.Value else - async { - let! ct = Async.CancellationToken - Interlocked.Increment(&requestCount) |> ignore - let enter = semaphore.WaitAsync(ct) - + let! ct = Async.CancellationToken + Interlocked.Increment(&requestCount) |> ignore + let enter = semaphore.WaitAsync(ct) + + try + do! enter |> Async.AwaitTask + + match cachedResult with + | ValueSome value -> return value + | _ -> + Thread.CurrentThread.CurrentUICulture <- GraphNode.culture + let! result = computation + cachedResult <- ValueSome result + return result + finally + // At this point, the semaphore awaiter is either already completed or about to get canceled. + // If calling Wait() does not throw an exception it means the semaphore was successfully taken and needs to be released. try - do! enter |> Async.AwaitTask - - match cachedResult with - | ValueSome value -> return value - | _ -> - Thread.CurrentThread.CurrentUICulture <- GraphNode.culture - let! result = computation - cachedResult <- ValueSome result - cachedResultNode <- async.Return result - computation <- Unchecked.defaultof<_> - return result - finally - // At this point, the semaphore awaiter is either already completed or about to get canceled. - // If calling Wait() does not throw an exception it means the semaphore was successfully taken and needs to be released. - try - enter.Wait() - semaphore.Release() |> ignore - with _ -> - () - - Interlocked.Decrement(&requestCount) |> ignore + enter.Wait() + semaphore.Release() |> ignore + with _ -> + () + + Interlocked.Decrement(&requestCount) |> ignore } member _.TryPeekValue() = cachedResult @@ -74,7 +67,6 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T member _.IsComputing = requestCount > 0 static member FromResult(result: 'T) = - let nodeResult = async.Return result - GraphNode(nodeResult, ValueSome result, nodeResult) + GraphNode(async2 { return result }, ValueSome result) - new(computation) = GraphNode(computation, ValueNone, Unchecked.defaultof<_>) + new(computation) = GraphNode(computation, ValueNone) diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 2b3016bf99..44101ffad8 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -2,6 +2,8 @@ module internal FSharp.Compiler.BuildGraph +open Internal.Utilities.Library + /// Contains helpers related to the build graph [] module internal GraphNode = @@ -18,7 +20,7 @@ module internal GraphNode = type internal GraphNode<'T> = /// - computation - The computation code to run. - new: computation: Async<'T> -> GraphNode<'T> + new: computation: IAsync2<'T> -> GraphNode<'T> /// Creates a GraphNode with given result already cached. static member FromResult: 'T -> GraphNode<'T> @@ -26,7 +28,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 -> Async<'T> + member GetOrComputeValue: unit -> IAsync2<'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 1ef603a2a9..4be3a5903c 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -984,3 +984,6 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } + + let Sequential2 computations = computations |> Seq.map Async2.toAsync |> Sequential + let Parallel2 computations = computations |> Seq.map Async2.toAsync |> Parallel diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index f545babce8..6237cb89f2 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -9,6 +9,8 @@ open FSharp.Compiler.Text open System.Runtime.CompilerServices open System.Runtime.InteropServices +open Internal.Utilities.Library + /// Represents the style being used to format errors [] type DiagnosticStyle = @@ -493,6 +495,8 @@ module MultipleDiagnosticsLoggers = /// 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> + val Parallel2: computations: #IAsync2<'T> seq -> Async<'T array> /// Run computations sequentially starting immediately on the current thread. val Sequential: computations: Async<'T> seq -> Async<'T array> + val Sequential2: computations: #IAsync2<'T> seq -> Async<'T array> diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index b6ffa72ea9..e272b50e6d 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -368,7 +368,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) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| Activity.Tags.project, options.ProjectFileName |] @@ -474,14 +474,14 @@ type internal BackgroundCompiler let tryGetBuilderNode options = incrementalBuildersCache.TryGet(AnyCallerThread, options) - let tryGetBuilder options : Async option = + let tryGetBuilder options : IAsync2 option = tryGetBuilderNode options |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetSimilarBuilder options : Async option = + let tryGetSimilarBuilder options : IAsync2 option = incrementalBuildersCache.TryGetSimilar(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetAnyBuilder options : Async option = + let tryGetAnyBuilder options : IAsync2 option = incrementalBuildersCache.TryGetAny(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) @@ -495,14 +495,14 @@ type internal BackgroundCompiler getBuilderNode) let createAndGetBuilder (options, userOpName) = - async { + async2 { let! ct = Async.CancellationToken let getBuilderNode = createBuilderNode (options, userOpName, ct) return! getBuilderNode.GetOrComputeValue() } - let getOrCreateBuilder (options, userOpName) : Async = - async { + let getOrCreateBuilder (options, userOpName) : IAsync2 = + async2 { use! _holder = Async2.UseTokenAsync() match tryGetBuilder options with @@ -558,7 +558,7 @@ type internal BackgroundCompiler | _ -> let res = GraphNode( - async { + async2 { let! res = self.CheckOneFileImplAux( parseResults, @@ -638,7 +638,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) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" @@ -678,7 +678,7 @@ type internal BackgroundCompiler } member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] @@ -764,7 +764,7 @@ type internal BackgroundCompiler creationDiags: FSharpDiagnostic[] ) = - async { + async2 { match! bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) with | Some(_, results) -> return FSharpCheckFileAnswer.Succeeded results | _ -> @@ -779,7 +779,7 @@ type internal BackgroundCompiler member bc.CheckFileInProjectAllowingStaleCachedResults (parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" @@ -790,7 +790,7 @@ type internal BackgroundCompiler |] let! cachedResults = - async { + async2 { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) match builderOpt with @@ -833,7 +833,7 @@ type internal BackgroundCompiler member bc.CheckFileInProject (parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.CheckFileInProject" @@ -876,7 +876,7 @@ type internal BackgroundCompiler member bc.ParseAndCheckFileInProject (fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" @@ -945,7 +945,7 @@ type internal BackgroundCompiler } member _.NotifyFileChanged(fileName, options, userOpName) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.NotifyFileChanged" @@ -964,7 +964,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) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" @@ -1071,7 +1071,7 @@ type internal BackgroundCompiler member _.FindReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.FindReferencesInFile" @@ -1099,7 +1099,7 @@ type internal BackgroundCompiler } member _.GetSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, userOpName: string) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" @@ -1162,7 +1162,7 @@ type internal BackgroundCompiler /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = - async { + async2 { let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -1235,7 +1235,7 @@ type internal BackgroundCompiler } member _.GetAssemblyData(options, userOpName) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.GetAssemblyData" @@ -1252,6 +1252,7 @@ type internal BackgroundCompiler let! _, _, tcAssemblyDataOpt, _ = builder.GetCheckResultsAndImplementationsForProject() return tcAssemblyDataOpt } + |> Async2.toAsync /// Get the timestamp that would be on the output if fully built immediately member private _.TryGetLogicalTimeStampForProject(cache, options) = @@ -1480,13 +1481,14 @@ type internal BackgroundCompiler options: FSharpProjectOptions, userOpName: string ) : Async = - async { + async2 { ignore parseResults let! _, result = this.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) return result } + |> Async2.toAsync member _.CheckFileInProjectAllowingStaleCachedResults ( @@ -1497,7 +1499,7 @@ type internal BackgroundCompiler options: FSharpProjectOptions, userOpName: string ) : Async = - self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) + self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync member _.ClearCache(options: seq, userOpName: string) : unit = self.ClearCache(options, userOpName) @@ -1511,10 +1513,10 @@ type internal BackgroundCompiler member _.FindReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) : Async> = - self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) + self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) |> Async2.toAsync member this.FindReferencesInFile(fileName, projectSnapshot, symbol, userOpName) = - this.FindReferencesInFile(fileName, projectSnapshot.ToOptions(), symbol, true, userOpName) + this.FindReferencesInFile(fileName, projectSnapshot.ToOptions(), symbol, true, userOpName) |> Async2.toAsync member _.FrameworkImportsCache: FrameworkImportsCache = self.FrameworkImportsCache @@ -1529,17 +1531,17 @@ type internal BackgroundCompiler member _.GetBackgroundCheckResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) + self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync member _.GetBackgroundParseResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync member _.GetCachedCheckFileResult (builder: IncrementalBuilder, fileName: string, sourceText: ISourceText, options: FSharpProjectOptions) : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = - self.GetCachedCheckFileResult(builder, fileName, sourceText, options) + self.GetCachedCheckFileResult(builder, fileName, sourceText, options) |> Async2.toAsync member _.GetProjectOptionsFromScript ( @@ -1611,12 +1613,12 @@ type internal BackgroundCompiler member _.GetSemanticClassificationForFile (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetSemanticClassificationForFile(fileName, options, userOpName) + self.GetSemanticClassificationForFile(fileName, options, userOpName) |> Async2.toAsync member _.GetSemanticClassificationForFile (fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string) : Async = - self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) + self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) |> Async2.toAsync member _.InvalidateConfiguration(options: FSharpProjectOptions, userOpName: string) : unit = self.InvalidateConfiguration(options, userOpName) @@ -1626,7 +1628,7 @@ type internal BackgroundCompiler self.InvalidateConfiguration(options, userOpName) member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.NotifyFileChanged(fileName, options, userOpName) + self.NotifyFileChanged(fileName, options, userOpName) |> Async2.toAsync member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async = self.NotifyProjectCleaned(options, userOpName) @@ -1634,7 +1636,7 @@ type internal BackgroundCompiler member _.ParseAndCheckFileInProject (fileName: string, fileVersion: int, sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string) : Async = - self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync member _.ParseAndCheckFileInProject (fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) @@ -1647,14 +1649,14 @@ type internal BackgroundCompiler let! sourceText = fileSnapshot.GetSource() |> Async.AwaitTask let options = projectSnapshot.ToOptions() - return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) + return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) |> Async2.toAsync } member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async = - self.ParseAndCheckProject(options, userOpName) + self.ParseAndCheckProject(options, userOpName) |> Async2.toAsync member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = - self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) + self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) |> Async2.toAsync member _.ParseFile (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) @@ -1664,7 +1666,7 @@ type internal BackgroundCompiler member _.ParseFile(fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) = let options = projectSnapshot.ToOptions() - self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync member _.ProjectChecked: IEvent = self.ProjectChecked diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 8aefb7f825..9589916a22 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -46,7 +46,7 @@ type DelayedILModuleReader = /// Will lazily create the ILModuleReader. /// Is only evaluated once and can be called by multiple threads. - member internal TryGetILModuleReader: unit -> Async2 + member internal TryGetILModuleReader: unit -> IAsync2 /// Unused in this API type public FSharpUnresolvedReferencesSet = internal FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list @@ -501,7 +501,7 @@ type public FSharpCheckFileResults = parseErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool -> - Async2 + IAsync2 /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -618,7 +618,7 @@ type internal FsiInteractiveChecker = member internal ParseAndCheckInteraction: sourceText: ISourceText * ?userOpName: string -> - Async2 + IAsync2 module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index cf171e78f0..82d5fd0a70 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) = - async { + async2 { IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) use _ = Activity.start "IncrementalBuildSyntaxTree.parse" @@ -247,8 +247,8 @@ type BoundModel private ( ?tcStateOpt: GraphNode * GraphNode ) = - let getTypeCheck (syntaxTree: SyntaxTree) : Async = - async { + let getTypeCheck (syntaxTree: SyntaxTree) : IAsync2 = + async2 { let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] @@ -317,13 +317,13 @@ type BoundModel private ( | _ -> None let getTcInfo (typeCheck: GraphNode) = - async { + async2 { let! tcInfo , _, _, _, _ = typeCheck.GetOrComputeValue() return tcInfo } |> GraphNode let getTcInfoExtras (typeCheck: GraphNode) = - async { + async2 { let! _ , sink, implFile, fileName, _ = typeCheck.GetOrComputeValue() // Build symbol keys let itemKeyStore, semanticClassification = @@ -361,17 +361,17 @@ type BoundModel private ( } } |> GraphNode - let defaultTypeCheck = async { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree", [||] } + let defaultTypeCheck = async2 { 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 = - async { + async2 { let! _, _, _, _, diags = typeCheckNode.GetOrComputeValue() return diags } |> GraphNode let startComputingFullTypeCheck = - async { + async2 { let! _ = tcInfoExtras.GetOrComputeValue() return! diagnostics.GetOrComputeValue() } @@ -386,7 +386,7 @@ type BoundModel private ( GraphNode.FromResult tcInfo, tcInfoExtras | _ -> // start computing extras, so that typeCheckNode can be GC'd quickly - startComputingFullTypeCheck |> Async.Catch |> Async.Ignore |> Async.Start + startComputingFullTypeCheck |> Async2.toAsync |> Async.Catch |> Async.Ignore |> Async.Start getTcInfo typeCheckNode, tcInfoExtras member val Diagnostics = diagnostics @@ -412,13 +412,13 @@ type BoundModel private ( member this.GetOrComputeTcInfoExtras = this.TcInfoExtras.GetOrComputeValue - member this.GetOrComputeTcInfoWithExtras() = async { + member this.GetOrComputeTcInfoWithExtras() = async2 { let! tcInfo = this.TcInfo.GetOrComputeValue() let! tcInfoExtras = this.TcInfoExtras.GetOrComputeValue() return tcInfo, tcInfoExtras } - member this.Next(syntaxTree) = async { + member this.Next(syntaxTree) = async2 { let! tcInfo = this.TcInfo.GetOrComputeValue() return BoundModel( @@ -437,7 +437,7 @@ type BoundModel private ( } member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = - async { + async2 { let! tcInfo = this.TcInfo.GetOrComputeValue() let finishState = { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } return @@ -534,7 +534,7 @@ type FrameworkImportsCache(size) = match frameworkTcImportsCache.TryGet (AnyCallerThread, key) with | Some lazyWork -> lazyWork | None -> - let lazyWork = GraphNode(async { + let lazyWork = GraphNode(async2 { let tcConfigP = TcConfigProvider.Constant tcConfig return! TcImports.BuildFrameworkTcImports (tcConfigP, frameworkDLLs, nonFrameworkResolutions) }) @@ -546,7 +546,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) = - async { + async2 { // Split into installed and not installed. let frameworkDLLs, nonFrameworkResolutions, unresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) let node = this.GetNode(tcConfig, frameworkDLLs, nonFrameworkResolutions) @@ -581,6 +581,7 @@ type FrameworkImportsCache(size) = return tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolved } + |> Async2.toAsync /// Represents the interim state of checking an assembly [] @@ -600,21 +601,23 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime, projectTi member _.TryPeekTcInfoWithExtras() = boundModel.TryPeekTcInfoWithExtras() - member _.GetOrComputeTcInfo() = boundModel.GetOrComputeTcInfo() + member _.GetOrComputeTcInfo() = boundModel.GetOrComputeTcInfo() |> Async2.toAsync - member _.GetOrComputeTcInfoWithExtras() = boundModel.GetOrComputeTcInfoWithExtras() + member _.GetOrComputeTcInfoWithExtras() = boundModel.GetOrComputeTcInfoWithExtras() |> Async2.toAsync member _.GetOrComputeItemKeyStoreIfEnabled() = - async { + async2 { let! info = boundModel.GetOrComputeTcInfoExtras() return info.itemKeyStore } + |> Async2.toAsync member _.GetOrComputeSemanticClassificationIfEnabled() = - async { + async2 { let! info = boundModel.GetOrComputeTcInfoExtras() return info.semanticClassificationKeyStore } + |> Async2.toAsync [] module Utilities = @@ -760,28 +763,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) = - async { + async2 { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> MultipleDiagnosticsLoggers.Sequential + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> MultipleDiagnosticsLoggers.Sequential2 let! tcInfos = computedBoundModels - |> Seq.map (fun boundModel -> async { return! boundModel.GetOrComputeTcInfo() }) - |> MultipleDiagnosticsLoggers.Sequential + |> Seq.map (fun boundModel -> async2 { return! boundModel.GetOrComputeTcInfo() }) + |> MultipleDiagnosticsLoggers.Sequential2 // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. let! latestImplFiles = computedBoundModels - |> Seq.map (fun boundModel -> async { + |> Seq.map (fun boundModel -> async2 { if partialCheck then return None else let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() return tcInfoExtras.latestImplFile }) - |> MultipleDiagnosticsLoggers.Parallel + |> MultipleDiagnosticsLoggers.Parallel2 let results = [ for tcInfo, latestImplFile in Seq.zip tcInfos latestImplFiles -> @@ -850,7 +853,7 @@ module IncrementalBuilderHelpers = let! partialDiagnostics = computedBoundModels |> Seq.map (fun m -> m.Diagnostics.GetOrComputeValue()) - |> MultipleDiagnosticsLoggers.Parallel + |> MultipleDiagnosticsLoggers.Parallel2 let diagnostics = [ diagnosticsLogger.GetDiagnostics() yield! partialDiagnostics |> Seq.rev @@ -970,13 +973,13 @@ module IncrementalBuilderStateHelpers = type BuildStatus = Invalidated | Good let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = - GraphNode(async { + GraphNode(async2 { let! prevBoundModel = prevBoundModel.GetOrComputeValue() return! prevBoundModel.Next(syntaxTree) }) let createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = - GraphNode(async { + GraphNode(async2 { use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|] let! result = FinalizeTypeCheckTask @@ -1144,7 +1147,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc tryGetSlot state (slot - 1) let evalUpToTargetSlot (state: IncrementalBuilderState) targetSlot = - async { + async2 { if targetSlot < 0 then return Some(initialBoundModel, defaultTimeStamp) else @@ -1175,9 +1178,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let mutable currentState = state - let setCurrentState state cache (ct: CancellationToken) = - async { - do! semaphore.WaitAsync(ct) |> Async.AwaitTask + let setCurrentState state cache = + async2 { + let ct = Async2.CancellationToken + do! semaphore.WaitAsync(ct) try ct.ThrowIfCancellationRequested() currentState <- computeStampedFileNames initialState state cache @@ -1185,11 +1189,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc semaphore.Release() |> ignore } - let checkFileTimeStamps (cache: TimeStampCache) = - async { - let! ct = Async.CancellationToken - do! setCurrentState currentState cache ct - } + let checkFileTimeStamps (cache: TimeStampCache) = setCurrentState currentState cache do IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBECreated) @@ -1217,12 +1217,13 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member _.AllDependenciesDeprecated = allDependencies member _.PopulatePartialCheckingResults () = - async { + async2 { let cache = TimeStampCache defaultTimeStamp // One per step do! checkFileTimeStamps cache let! _ = currentState.finalizedBoundModel.GetOrComputeValue() projectChecked.Trigger() } + |> Async2.toAsync member builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName: PartialCheckResults option = let slotOfFile = builder.GetSlotOfFileName fileName @@ -1259,7 +1260,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc (builder.TryGetCheckResultsBeforeFileInProject fileName).IsSome member builder.GetCheckResultsBeforeSlotInProject slotOfFile = - async { + async2 { let cache = TimeStampCache defaultTimeStamp do! checkFileTimeStamps cache let! result = evalUpToTargetSlot currentState (slotOfFile - 1) @@ -1269,9 +1270,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return PartialCheckResults(boundModel, timestamp, projectTimeStamp) | None -> return! failwith "Expected results to be ready. (GetCheckResultsBeforeSlotInProject)." } + |> Async2.toAsync member builder.GetFullCheckResultsBeforeSlotInProject slotOfFile = - async { + async2 { let cache = TimeStampCache defaultTimeStamp do! checkFileTimeStamps cache let! result = evalUpToTargetSlot currentState (slotOfFile - 1) @@ -1282,6 +1284,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return PartialCheckResults(boundModel, timestamp, projectTimeStamp) | None -> return! failwith "Expected results to be ready. (GetFullCheckResultsBeforeSlotInProject)." } + |> Async2.toAsync member builder.GetCheckResultsBeforeFileInProject fileName = let slotOfFile = builder.GetSlotOfFileName fileName @@ -1296,17 +1299,18 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc builder.GetFullCheckResultsBeforeSlotInProject slotOfFile member builder.GetFullCheckResultsAfterFileInProject fileName = - async { + async2 { let slotOfFile = builder.GetSlotOfFileName fileName + 1 let! result = builder.GetFullCheckResultsBeforeSlotInProject(slotOfFile) return result } + |> Async2.toAsync member builder.GetCheckResultsAfterLastFileInProject () = builder.GetCheckResultsBeforeSlotInProject(builder.GetSlotsCount()) member builder.GetCheckResultsAndImplementationsForProject() = - async { + async2 { let cache = TimeStampCache(defaultTimeStamp) do! checkFileTimeStamps cache let! result = currentState.finalizedBoundModel.GetOrComputeValue() @@ -1316,14 +1320,16 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let projectTimeStamp = builder.GetLogicalTimeStampForProject(cache) return PartialCheckResults (boundModel, timestamp, projectTimeStamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt } + |> Async2.toAsync member builder.GetFullCheckResultsAndImplementationsForProject() = - async { + async2 { let! result = builder.GetCheckResultsAndImplementationsForProject() let results, _, _, _ = result let! _ = results.GetOrComputeTcInfoWithExtras() // Make sure we forcefully evaluate the info return result } + |> Async2.toAsync member builder.GetLogicalTimeStampForFileInProject(filename: string) = let slot = builder.GetSlotOfFileName(filename) @@ -1363,18 +1369,18 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let slotOfFile = builder.GetSlotOfFileName fileName let syntaxTree = currentState.slots[slotOfFile].SyntaxTree syntaxTree.ParseNode.GetOrComputeValue() - |> Async.RunSynchronously + |> Async2.runWithoutCancellation member builder.NotifyFileChanged(fileName, timeStamp) = - async { + async2 { let slotOfFile = builder.GetSlotOfFileName fileName let cache = TimeStampCache defaultTimeStamp - let! ct = Async.CancellationToken do! setCurrentState { currentState with slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } - cache ct + cache } + |> Async2.toAsync member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Source.FilePath) |> List.ofSeq @@ -1407,14 +1413,14 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let useSimpleResolutionSwitch = "--simpleresolution" - async { + async2 { // Trap and report diagnostics from creation. let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! builderOpt = - async { + async2 { try // Create the builder. @@ -1670,3 +1676,4 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return builderOpt, diagnostics } + |> Async2.toAsync diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 73e96a40bf..76ff8cb5a3 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -6,6 +6,9 @@ open System.Threading.Tasks #nowarn 3513 +type internal IAsync2<'t> = + abstract Start: unit -> Task<'t> + module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -27,6 +30,9 @@ module internal Async2Implementation = let currentContext = AsyncLocal() + type Invokable<'Async2, 'TResult + when 'Async2: (member Start: unit -> Task<'TResult>)> = 'Async2 + /// A structure that looks like an Awaiter type Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion @@ -148,21 +154,11 @@ module internal Async2Implementation = [] type Async2<'T>(start: unit -> Task<'T>) = - //static let tailCallSource = AsyncLocal voption>() - - member _.startWithContext context = - let old = currentContext.Value - currentContext.Value <- context + interface IAsync2<'T> with - try - BindContext.ResetBindCount() - start () - finally - currentContext.Value <- old + member _.Start() = start () - member _.StartBound() = - failIfNot currentContext.Value.IsNested "StartBound requires a nested context" - start () + //static let tailCallSource = AsyncLocal voption>() [] type Async2Data<'t> = @@ -183,11 +179,13 @@ module internal Async2Implementation = let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> raise exn + | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> + raise exn | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: Async2Code<_, _>) = Async2Code(fun sm -> + if currentContext.Value.Token.IsCancellationRequested then printfn "throwing cancellation" currentContext.Value.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) @@ -283,7 +281,7 @@ module internal Async2Implementation = [] member inline this.ReturnFrom(awaiter) : Async2Code<'T, 'T> = this.Bind(awaiter, this.Return) - static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = + static member inline RunDynamic(code: Async2Code<'T, 'T>) : IAsync2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) let resumptionInfo () = @@ -339,7 +337,7 @@ module internal Async2Implementation = copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) - member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = + member inline _.Run(code: Async2Code<'T, 'T>) : IAsync2<'T> = if __useResumableCode then __stateMachine, _> @@ -380,7 +378,7 @@ module internal Async2Implementation = else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code.StartBound().GetAwaiter() + member inline _.Source(code: IAsync2<_>) = code.Start().GetAwaiter() [] module internal Async2AutoOpens = @@ -410,8 +408,6 @@ module internal Async2MediumPriority = open Async2Implementation -type internal Async2<'t> = Async2Implementation.Async2<'t> - type internal Async2 = static member CancellationToken = currentContext.Value.Token @@ -433,30 +429,39 @@ type internal Async2 = module internal Async2 = - let run ct (code: Async2<'t>) = + let inline start (code: IAsync2<_>) = code.Start() + + let inline startWithContext context code = + let old = currentContext.Value + currentContext.Value <- context + + try + BindContext.ResetBindCount() + start code + finally + currentContext.Value <- old + + let run ct (code: IAsync2<'t>) = let context = { Token = ct; IsNested = true } if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - code.startWithContext(context).GetAwaiter().GetResult() + (code |> startWithContext context).GetAwaiter().GetResult() else - Task.Run<'t>(fun () -> code.startWithContext (context)).GetAwaiter().GetResult() - - let startAsTask (code: Async2<'t>) = - let context = - { - Token = CancellationToken.None - IsNested = true - } - - code.startWithContext context + Task.Run<'t>(fun () -> code |> startWithContext context).GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code - let toAsync (code: Async2<'t>) = + let toAsync (code: IAsync2<'t>) = + async { let! ct = Async.CancellationToken - return run ct code + return! Async.FromContinuations <| fun (cont, econt, ccont) -> + try + cont (run ct code) + with + | :? OperationCanceledException as oce when oce.CancellationToken = ct -> ccont oce + | exn -> econt exn } diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 4769b4c322..9f6e95ae95 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -12,534 +12,534 @@ open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics -module BuildGraphTests = +//module BuildGraphTests = - [] - let private createNode () = - let o = obj () - GraphNode(async { - Assert.shouldBeTrue (o <> null) - return 1 - }), WeakReference(o) +// [] +// let private createNode () = +// let o = obj () +// GraphNode(async { +// Assert.shouldBeTrue (o <> null) +// return 1 +// }), WeakReference(o) - [] - let ``Initialization of graph node should not have a computed value``() = - let node = GraphNode(async { return 1 }) - Assert.shouldBeTrue(node.TryPeekValue().IsNone) - Assert.shouldBeFalse(node.HasValue) +// [] +// let ``Initialization of graph node should not have a computed value``() = +// let node = GraphNode(async { return 1 }) +// Assert.shouldBeTrue(node.TryPeekValue().IsNone) +// Assert.shouldBeFalse(node.HasValue) - [] - let ``Two requests to get a value asynchronously should be successful``() = - let resetEvent = new ManualResetEvent(false) - let resetEventInAsync = new ManualResetEvent(false) +// [] +// let ``Two requests to get a value asynchronously should be successful``() = +// let resetEvent = new ManualResetEvent(false) +// let resetEventInAsync = new ManualResetEvent(false) - let graphNode = - GraphNode(async { - resetEventInAsync.Set() |> ignore - let! _ = Async.AwaitWaitHandle(resetEvent) - return 1 - }) +// let graphNode = +// GraphNode(async { +// resetEventInAsync.Set() |> ignore +// let! _ = Async.AwaitWaitHandle(resetEvent) +// return 1 +// }) - let task1 = - async { - let! _ = graphNode.GetOrComputeValue() - () - } |> Async.StartAsTask +// let task1 = +// async { +// let! _ = graphNode.GetOrComputeValue() +// () +// } |> Async.StartAsTask - let task2 = - async { - let! _ = graphNode.GetOrComputeValue() - () - } |> Async.StartAsTask +// let task2 = +// async { +// let! _ = graphNode.GetOrComputeValue() +// () +// } |> Async.StartAsTask - resetEventInAsync.WaitOne() |> ignore - resetEvent.Set() |> ignore - try - task1.Wait(1000) |> ignore - task2.Wait() |> ignore - with - | :? TimeoutException -> reraise() - | _ -> () +// resetEventInAsync.WaitOne() |> ignore +// resetEvent.Set() |> ignore +// try +// task1.Wait(1000) |> ignore +// task2.Wait() |> ignore +// with +// | :? TimeoutException -> reraise() +// | _ -> () - [] - let ``Many requests to get a value asynchronously should only evaluate the computation once``() = - let requests = 10000 - let mutable computationCount = 0 +// [] +// let ``Many requests to get a value asynchronously should only evaluate the computation once``() = +// let requests = 10000 +// let mutable computationCount = 0 - let graphNode = - GraphNode(async { - computationCount <- computationCount + 1 - return 1 - }) +// let graphNode = +// GraphNode(async { +// computationCount <- computationCount + 1 +// return 1 +// }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) +// let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) - Async.RunImmediate(work) - |> ignore +// Async.RunImmediate(work) +// |> ignore - Assert.shouldBe 1 computationCount +// Assert.shouldBe 1 computationCount - [] - let ``Many requests to get a value asynchronously should get the correct value``() = - let requests = 10000 +// [] +// let ``Many requests to get a value asynchronously should get the correct value``() = +// let requests = 10000 - let graphNode = GraphNode(async { return 1 }) +// 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.RunImmediate(work) +// let result = Async.RunImmediate(work) - Assert.shouldNotBeEmpty result - Assert.shouldBe requests result.Length - result - |> Seq.iter (Assert.shouldBe 1) +// Assert.shouldNotBeEmpty result +// Assert.shouldBe requests result.Length +// result +// |> Seq.iter (Assert.shouldBe 1) - [] - let ``A request to get a value asynchronously should have its computation cleaned up by the GC``() = - let graphNode, weak = createNode () +// [] +// let ``A request to get a value asynchronously should have its computation cleaned up by the GC``() = +// let graphNode, weak = createNode () - GC.Collect(2, GCCollectionMode.Forced, true) +// GC.Collect(2, GCCollectionMode.Forced, true) - Assert.shouldBeTrue weak.IsAlive +// Assert.shouldBeTrue weak.IsAlive - Async.RunImmediate(graphNode.GetOrComputeValue()) - |> ignore +// Async.RunImmediate(graphNode.GetOrComputeValue()) +// |> ignore - GC.Collect(2, GCCollectionMode.Forced, true) +// GC.Collect(2, GCCollectionMode.Forced, true) - Assert.shouldBeFalse weak.IsAlive +// Assert.shouldBeFalse weak.IsAlive - [] - let ``Many requests to get a value asynchronously should have its computation cleaned up by the GC``() = - let requests = 10000 +// [] +// let ``Many requests to get a value asynchronously should have its computation cleaned up by the GC``() = +// let requests = 10000 - let graphNode, weak = createNode () +// let graphNode, weak = createNode () - GC.Collect(2, GCCollectionMode.Forced, true) +// GC.Collect(2, GCCollectionMode.Forced, true) - Assert.shouldBeTrue weak.IsAlive - - 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 { - return 1 - }) - - use cts = new CancellationTokenSource() - - let work = - 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 - - Assert.shouldBeTrue(ex <> null) - - [] - let ``A request can cancel 2``() = - let resetEvent = new ManualResetEvent(false) - - let graphNode = - GraphNode(async { - let! _ = Async.AwaitWaitHandle(resetEvent) - return 1 - }) - - use cts = new CancellationTokenSource() - - 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 - - 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``() = - let requests = 10000 - let resetEvent = new ManualResetEvent(false) - let mutable computationCountBeforeSleep = 0 - let mutable computationCount = 0 - - let graphNode = - GraphNode(async { - computationCountBeforeSleep <- computationCountBeforeSleep + 1 - let! _ = Async.AwaitWaitHandle(resetEvent) - computationCount <- computationCount + 1 - return 1 - }) - - use cts = new CancellationTokenSource() - - let work = - async { - let! _ = graphNode.GetOrComputeValue() - () - } - - let tasks = ResizeArray() - - for i = 0 to requests - 1 do - if i % 10 = 0 then - Async.StartAsTask(work, cancellationToken = cts.Token) - |> tasks.Add - else - Async.StartAsTask(work) - |> tasks.Add - - cts.Cancel() - resetEvent.Set() |> ignore - Async.RunImmediate(work) - |> ignore - - Assert.shouldBeTrue cts.IsCancellationRequested - Assert.shouldBeTrue(computationCountBeforeSleep > 0) - Assert.shouldBeTrue(computationCount >= 0) - - tasks - |> Seq.iter (fun x -> - try x.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> ()) - - [] - let ``GraphNode created from an already computed result will return it in tryPeekValue`` () = - let graphNode = GraphNode.FromResult 1 - - Assert.shouldBeTrue graphNode.HasValue - Assert.shouldBe (ValueSome 1) (graphNode.TryPeekValue()) - - type ExampleException(msg) = inherit System.Exception(msg) - - [] - let internal ``DiagnosticsThreadStatics preserved in async`` () = - let random = - let rng = Random() - fun n -> rng.Next n +// Assert.shouldBeTrue weak.IsAlive + +// 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 { +// return 1 +// }) + +// use cts = new CancellationTokenSource() + +// let work = +// 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 + +// Assert.shouldBeTrue(ex <> null) + +// [] +// let ``A request can cancel 2``() = +// let resetEvent = new ManualResetEvent(false) + +// let graphNode = +// GraphNode(async { +// let! _ = Async.AwaitWaitHandle(resetEvent) +// return 1 +// }) + +// use cts = new CancellationTokenSource() + +// 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 + +// 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``() = +// let requests = 10000 +// let resetEvent = new ManualResetEvent(false) +// let mutable computationCountBeforeSleep = 0 +// let mutable computationCount = 0 + +// let graphNode = +// GraphNode(async { +// computationCountBeforeSleep <- computationCountBeforeSleep + 1 +// let! _ = Async.AwaitWaitHandle(resetEvent) +// computationCount <- computationCount + 1 +// return 1 +// }) + +// use cts = new CancellationTokenSource() + +// let work = +// async { +// let! _ = graphNode.GetOrComputeValue() +// () +// } + +// let tasks = ResizeArray() + +// for i = 0 to requests - 1 do +// if i % 10 = 0 then +// Async.StartAsTask(work, cancellationToken = cts.Token) +// |> tasks.Add +// else +// Async.StartAsTask(work) +// |> tasks.Add + +// cts.Cancel() +// resetEvent.Set() |> ignore +// Async.RunImmediate(work) +// |> ignore + +// Assert.shouldBeTrue cts.IsCancellationRequested +// Assert.shouldBeTrue(computationCountBeforeSleep > 0) +// Assert.shouldBeTrue(computationCount >= 0) + +// tasks +// |> Seq.iter (fun x -> +// try x.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> ()) + +// [] +// let ``GraphNode created from an already computed result will return it in tryPeekValue`` () = +// let graphNode = GraphNode.FromResult 1 + +// Assert.shouldBeTrue graphNode.HasValue +// Assert.shouldBe (ValueSome 1) (graphNode.TryPeekValue()) + +// type ExampleException(msg) = inherit System.Exception(msg) + +// [] +// 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 - Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) - DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() - |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" - - errorR (ExampleException $"job {i}") - } +// 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}") +// } - let work (phase: BuildPhase) = - async { - let n = 8 - let logger = CapturingDiagnosticsLogger("test NodeCode") - use _ = new CompilationGlobalsScope(logger, phase) - let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel +// let work (phase: BuildPhase) = +// async { +// let n = 8 +// let logger = CapturingDiagnosticsLogger("test NodeCode") +// use _ = new CompilationGlobalsScope(logger, phase) +// let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel - let diags = logger.Diagnostics |> List.map fst +// let diags = logger.Diagnostics |> List.map fst - diags |> List.map _.Phase |> List.distinct |> Assert.shouldBe [ phase ] - diags |> List.map _.Exception.Message - |> Assert.shouldBe (List.init n <| sprintf "job %d") +// diags |> List.map _.Phase |> List.distinct |> Assert.shouldBe [ phase ] +// diags |> List.map _.Exception.Message +// |> Assert.shouldBe (List.init n <| sprintf "job %d") - Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) - } +// Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) +// } - let phases = [| - BuildPhase.DefaultPhase - BuildPhase.Compile - BuildPhase.Parameter - BuildPhase.Parse - BuildPhase.TypeCheck - BuildPhase.CodeGen - BuildPhase.Optimize - BuildPhase.IlxGen - BuildPhase.IlGen - BuildPhase.Output - BuildPhase.Interactive - |] +// let phases = [| +// BuildPhase.DefaultPhase +// BuildPhase.Compile +// BuildPhase.Parameter +// BuildPhase.Parse +// BuildPhase.TypeCheck +// BuildPhase.CodeGen +// BuildPhase.Optimize +// BuildPhase.IlxGen +// BuildPhase.IlGen +// BuildPhase.Output +// BuildPhase.Interactive +// |] - let pickRandomPhase _ = phases[random phases.Length] - Seq.init 100 pickRandomPhase - |> Seq.map work - |> Async.Parallel - |> Async.RunSynchronously +// let pickRandomPhase _ = phases[random phases.Length] +// Seq.init 100 pickRandomPhase +// |> Seq.map work +// |> Async.Parallel +// |> Async.RunSynchronously - exception TestException +// exception TestException - type internal SimpleConcurrentLogger(name) = - inherit DiagnosticsLogger(name) +// type internal SimpleConcurrentLogger(name) = +// inherit DiagnosticsLogger(name) - let mutable errorCount = 0 +// let mutable errorCount = 0 - override _.DiagnosticSink(d, s) = - if s = FSharpDiagnosticSeverity.Error then Interlocked.Increment(&errorCount) |> ignore +// override _.DiagnosticSink(d, s) = +// if s = FSharpDiagnosticSeverity.Error then Interlocked.Increment(&errorCount) |> ignore - override this.ErrorCount = errorCount +// override this.ErrorCount = errorCount - let loggerShouldBe logger = - DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger +// let loggerShouldBe logger = +// DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger - let errorCountShouldBe ec = - DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec +// let errorCountShouldBe ec = +// DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec - [] - let ``AsyncLocal diagnostics context works with TPL`` () = +// [] +// let ``AsyncLocal diagnostics context works with TPL`` () = - let task1 () = - List.init 20 (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 task1 () = +// List.init 20 (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 +// let task2 () = +// let commonLogger = SimpleConcurrentLogger "ListParallel concurrent logger" +// use _ = UseDiagnosticsLogger commonLogger - [1 .. 20] - |> Extras.ListParallel.map (fun _ -> - for _ in 1 .. 10 do - errorR TestException - Thread.Sleep 5 - loggerShouldBe commonLogger ) - |> ignore - errorCountShouldBe 200 - loggerShouldBe commonLogger +// [1 .. 20] +// |> Extras.ListParallel.map (fun _ -> +// for _ in 1 .. 10 do +// errorR TestException +// Thread.Sleep 5 +// loggerShouldBe commonLogger ) +// |> ignore +// errorCountShouldBe 200 +// loggerShouldBe commonLogger - Tasks.Parallel.Invoke(task1, task2) +// 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 +// 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 ``MultipleDiagnosticsLoggers capture diagnostics in correct order`` () = - let mutable prevError = "000." +// let mutable prevError = "000." - let errorCommitted msg = - // errors come in correct order - Assert.shouldBeTrue (msg > prevError) - prevError <- msg +// 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 work i = async { +// for c in 'A' .. 'F' do +// do! Async.SwitchToThreadPool() +// errorR (ExampleException $"%03d{i}{c}") +// } - let tasks = Seq.init 100 work +// let tasks = Seq.init 100 work - let logger = DiagnosticsLoggerWithCallback errorCommitted - use _ = UseDiagnosticsLogger logger - tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate +// let logger = DiagnosticsLoggerWithCallback errorCommitted +// use _ = UseDiagnosticsLogger logger +// tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate - // all errors committed - errorCountShouldBe 300 +// // all errors committed +// errorCountShouldBe 300 - tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate +// tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate - errorCountShouldBe 600 +// errorCountShouldBe 600 - [] - let ``MultipleDiagnosticsLoggers.Parallel finishes when any computation throws`` () = +// [] +// let ``MultipleDiagnosticsLoggers.Parallel finishes when any computation throws`` () = - let mutable count = 0 - use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger") +// let mutable count = 0 +// use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger") - let tasks = [ - async { failwith "computation failed" } +// let tasks = [ +// async { failwith "computation failed" } - for i in 1 .. 300 do - async { - errorR (ExampleException $"{Interlocked.Increment(&count)}") - error (ExampleException $"{Interlocked.Increment(&count)}") - } - ] +// for i in 1 .. 300 do +// async { +// errorR (ExampleException $"{Interlocked.Increment(&count)}") +// error (ExampleException $"{Interlocked.Increment(&count)}") +// } +// ] - task { - do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore +// task { +// do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore - // Diagnostics from all started tasks should be collected despite the exception. - errorCountShouldBe count - } +// // Diagnostics from all started tasks should be collected despite the exception. +// errorCountShouldBe count +// } - [] - let ``AsyncLocal diagnostics context flows correctly`` () = +// [] +// let ``AsyncLocal diagnostics context flows correctly`` () = - let work logger = async { - SetThreadDiagnosticsLoggerNoUnwind logger +// let work logger = async { +// SetThreadDiagnosticsLoggerNoUnwind logger - errorR TestException +// errorR TestException - loggerShouldBe logger - errorCountShouldBe 1 +// loggerShouldBe logger +// errorCountShouldBe 1 - do! Async.SwitchToNewThread() +// do! Async.SwitchToNewThread() - errorR TestException +// errorR TestException - loggerShouldBe logger - errorCountShouldBe 2 +// loggerShouldBe logger +// errorCountShouldBe 2 - do! Async.SwitchToThreadPool() +// do! Async.SwitchToThreadPool() - errorR TestException +// errorR TestException - loggerShouldBe logger - errorCountShouldBe 3 +// loggerShouldBe logger +// errorCountShouldBe 3 - let workInner = async { - do! async.Zero() - errorR TestException - loggerShouldBe logger - } +// let workInner = async { +// do! async.Zero() +// errorR TestException +// loggerShouldBe logger +// } - let! child = workInner |> Async.StartChild - let! childTask = workInner |> Async.StartChildAsTask +// let! child = workInner |> Async.StartChild +// let! childTask = workInner |> Async.StartChildAsTask - do! child - do! childTask |> Async.AwaitTask - errorCountShouldBe 5 - } +// 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 noErrorsTask = backgroundTask { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger - errorR TestException - do! Task.Yield() - errorR TestException - loggerShouldBe DiscardErrorsLogger - } - - let task = task { - errorR TestException - do! Task.Yield() - errorR TestException - 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 - )) - thread.Start() - thread.Join() - - Task.WaitAll(noErrorsTask, btask, task) - - Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore - - loggerShouldBe logger - errorCountShouldBe 17 - - async { - - // After Async.Parallel the continuation runs in the context of the last computation that finished. - do! - [ async { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] - |> Async.Parallel - |> Async.Ignore - loggerShouldBe DiscardErrorsLogger - - SetThreadDiagnosticsLoggerNoUnwind logger - - // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. - do! - [ async { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] - |> MultipleDiagnosticsLoggers.Parallel - |> Async.Ignore - loggerShouldBe logger - } - |> Async.RunImmediate - - // Synchronous code will affect current context: - - // This is synchronous, caller's context is affected - async { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger - do! Async.SwitchToNewThread() - loggerShouldBe DiscardErrorsLogger - } - |> Async.RunImmediate - loggerShouldBe DiscardErrorsLogger - - SetThreadDiagnosticsLoggerNoUnwind logger - // This runs in async continuation, so the context is forked. - async { - do! Async.Sleep 0 - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger - do! Async.SwitchToNewThread() - loggerShouldBe DiscardErrorsLogger - } - |> Async.RunImmediate - loggerShouldBe logger +// 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 noErrorsTask = backgroundTask { +// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger +// errorR TestException +// do! Task.Yield() +// errorR TestException +// loggerShouldBe DiscardErrorsLogger +// } + +// let task = task { +// errorR TestException +// do! Task.Yield() +// errorR TestException +// 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 +// )) +// thread.Start() +// thread.Join() + +// Task.WaitAll(noErrorsTask, btask, task) + +// Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore + +// loggerShouldBe logger +// errorCountShouldBe 17 + +// async { + +// // After Async.Parallel the continuation runs in the context of the last computation that finished. +// do! +// [ async { +// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] +// |> Async.Parallel +// |> Async.Ignore +// loggerShouldBe DiscardErrorsLogger + +// SetThreadDiagnosticsLoggerNoUnwind logger + +// // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. +// do! +// [ async { +// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] +// |> MultipleDiagnosticsLoggers.Parallel +// |> Async.Ignore +// loggerShouldBe logger +// } +// |> Async.RunImmediate + +// // Synchronous code will affect current context: + +// // This is synchronous, caller's context is affected +// async { +// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger +// do! Async.SwitchToNewThread() +// loggerShouldBe DiscardErrorsLogger +// } +// |> Async.RunImmediate +// loggerShouldBe DiscardErrorsLogger + +// SetThreadDiagnosticsLoggerNoUnwind logger +// // This runs in async continuation, so the context is forked. +// async { +// do! Async.Sleep 0 +// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger +// do! Async.SwitchToNewThread() +// loggerShouldBe DiscardErrorsLogger +// } +// |> Async.RunImmediate +// loggerShouldBe logger From ec3bd066be465194978e251397c78367df4289c7 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 6 Sep 2025 11:46:57 +0200 Subject: [PATCH 20/48] use in more places, also in tests --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fsi | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 +- src/Compiler/Facilities/BuildGraph.fs | 68 +- src/Compiler/Facilities/BuildGraph.fsi | 4 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 7 +- src/Compiler/Facilities/DiagnosticsLogger.fsi | 4 +- src/Compiler/Service/BackgroundCompiler.fs | 45 +- src/Compiler/Service/FSharpCheckerResults.fsi | 6 +- src/Compiler/Service/IncrementalBuild.fs | 2 +- src/Compiler/Utilities/Async2.fs | 83 +- .../BuildGraphTests.fs | 914 +++++++++--------- .../FSharp.Compiler.Service.Tests.fsproj | 6 + 14 files changed, 604 insertions(+), 551 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index eae9f43014..e6525223fc 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4871,7 +4871,7 @@ module TcDeclarations = // Bind module types //------------------------------------------------------------------------- #nowarn 3511 -let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: IAsync2 = +let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async2 = async2 { let g = cenv.g try diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index 05f0a6f05b..1a2be70f80 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -60,7 +60,7 @@ val CheckOneImplFile: ModuleOrNamespaceType option * ParsedImplFileInput * FSharpDiagnosticOptions -> - IAsync2 + Async2 val CheckOneSigFile: TcGlobals * @@ -73,7 +73,7 @@ val CheckOneSigFile: FSharpDiagnosticOptions -> TcEnv -> ParsedSigFileInput -> - IAsync2 + Async2 exception NotUpperCaseConstructor of range: range diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index a395f4a3cc..ab15cee94a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1225,7 +1225,7 @@ let CheckOneInput tcSink: TcResultsSink, tcState: TcState, input: ParsedInput - ) : IAsync2 = + ) : Async2 = async2 { try use _ = @@ -1445,7 +1445,7 @@ let CheckOneInputWithCallback _skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool ) - : IAsync2> = + : Async2> = async2 { try CheckSimulateException tcConfig diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index d22b6d40d2..6233cd17c1 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -180,7 +180,7 @@ val CheckOneInput: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - IAsync2<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> + Async2<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> val CheckOneInputWithCallback: node: NodeToTypeCheck -> @@ -193,7 +193,7 @@ val CheckOneInputWithCallback: tcState: TcState * input: ParsedInput * _skipImplIfSigExists: bool -> - IAsync2> + Async2> val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -248,4 +248,4 @@ val CheckOneInputAndFinish: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - IAsync2<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> + Async2<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index f2b5284b8e..7a19c4113d 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -22,42 +22,51 @@ module GraphNode = | None -> () [] -type GraphNode<'T> private (computation: IAsync2<'T>, cachedResult: ValueOption<'T>) = +type internal GraphNode<'T> private (computation: Async2<'T>, cachedResult: ValueOption<'T>, cachedResultNode: Async2<'T>) = + + let mutable computation = computation let mutable requestCount = 0 let mutable cachedResult = cachedResult + let mutable cachedResultNode: Async2<'T> = cachedResultNode + + let isCachedResultNodeNotNull () = + not (obj.ReferenceEquals(cachedResultNode, null)) let semaphore = new SemaphoreSlim(1, 1) member _.GetOrComputeValue() = - async2 { - if cachedResult.IsSome then - return cachedResult.Value + // fast path + if isCachedResultNodeNotNull () then + cachedResultNode else - let! ct = Async.CancellationToken - Interlocked.Increment(&requestCount) |> ignore - let enter = semaphore.WaitAsync(ct) - - try - do! enter |> Async.AwaitTask - - match cachedResult with - | ValueSome value -> return value - | _ -> - Thread.CurrentThread.CurrentUICulture <- GraphNode.culture - let! result = computation - cachedResult <- ValueSome result - return result - finally - // At this point, the semaphore awaiter is either already completed or about to get canceled. - // If calling Wait() does not throw an exception it means the semaphore was successfully taken and needs to be released. - try - enter.Wait() - semaphore.Release() |> ignore - with _ -> - () + async2 { + let ct = Async2.CancellationToken + Interlocked.Increment(&requestCount) |> ignore - Interlocked.Decrement(&requestCount) |> ignore + let mutable acquired = false + + try + do! semaphore.WaitAsync(ct) + acquired <- true + + match cachedResult with + | ValueSome value -> return value + | _ -> + Thread.CurrentThread.CurrentUICulture <- GraphNode.culture + let! result = computation + cachedResult <- ValueSome result + cachedResultNode <- Async2.fromValue result + computation <- Unchecked.defaultof<_> + return result + finally + if acquired then + try + semaphore.Release() |> ignore + with _ -> + () + + Interlocked.Decrement(&requestCount) |> ignore } member _.TryPeekValue() = cachedResult @@ -67,6 +76,7 @@ type GraphNode<'T> private (computation: IAsync2<'T>, cachedResult: ValueOption< member _.IsComputing = requestCount > 0 static member FromResult(result: 'T) = - GraphNode(async2 { return result }, ValueSome result) + let nodeResult = Async2.fromValue result + GraphNode(nodeResult, ValueSome result, nodeResult) - new(computation) = GraphNode(computation, ValueNone) + new(computation) = GraphNode(computation, ValueNone, Unchecked.defaultof<_>) diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 44101ffad8..b3d55dd91f 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -20,7 +20,7 @@ module internal GraphNode = type internal GraphNode<'T> = /// - computation - The computation code to run. - new: computation: IAsync2<'T> -> GraphNode<'T> + new: computation: Async2<'T> -> GraphNode<'T> /// Creates a GraphNode with given result already cached. static member FromResult: 'T -> GraphNode<'T> @@ -28,7 +28,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 -> IAsync2<'T> + member GetOrComputeValue: unit -> Async2<'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 4be3a5903c..6dc5202f81 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -985,5 +985,8 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } - let Sequential2 computations = computations |> Seq.map Async2.toAsync |> Sequential - let Parallel2 computations = computations |> Seq.map Async2.toAsync |> Parallel + let Sequential2 computations = + computations |> Seq.map Async2.toAsync |> Sequential + + let Parallel2 computations = + computations |> Seq.map Async2.toAsync |> Parallel diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 6237cb89f2..7a8b915add 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -495,8 +495,8 @@ module MultipleDiagnosticsLoggers = /// 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> - val Parallel2: computations: #IAsync2<'T> seq -> Async<'T array> + val Parallel2: computations: #Async2<'T> seq -> Async<'T array> /// Run computations sequentially starting immediately on the current thread. val Sequential: computations: Async<'T> seq -> Async<'T array> - val Sequential2: computations: #IAsync2<'T> seq -> Async<'T array> + val Sequential2: computations: #Async2<'T> seq -> Async<'T array> diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index e272b50e6d..595ff02f40 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -474,14 +474,14 @@ type internal BackgroundCompiler let tryGetBuilderNode options = incrementalBuildersCache.TryGet(AnyCallerThread, options) - let tryGetBuilder options : IAsync2 option = + let tryGetBuilder options : Async2 option = tryGetBuilderNode options |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetSimilarBuilder options : IAsync2 option = + let tryGetSimilarBuilder options : Async2 option = incrementalBuildersCache.TryGetSimilar(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) - let tryGetAnyBuilder options : IAsync2 option = + let tryGetAnyBuilder options : Async2 option = incrementalBuildersCache.TryGetAny(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) @@ -501,7 +501,7 @@ type internal BackgroundCompiler return! getBuilderNode.GetOrComputeValue() } - let getOrCreateBuilder (options, userOpName) : IAsync2 = + let getOrCreateBuilder (options, userOpName) : Async2 = async2 { use! _holder = Async2.UseTokenAsync() @@ -1499,7 +1499,8 @@ type internal BackgroundCompiler options: FSharpProjectOptions, userOpName: string ) : Async = - self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync + self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) + |> Async2.toAsync member _.ClearCache(options: seq, userOpName: string) : unit = self.ClearCache(options, userOpName) @@ -1513,10 +1514,12 @@ type internal BackgroundCompiler member _.FindReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) : Async> = - self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) |> Async2.toAsync + self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) + |> Async2.toAsync member this.FindReferencesInFile(fileName, projectSnapshot, symbol, userOpName) = - this.FindReferencesInFile(fileName, projectSnapshot.ToOptions(), symbol, true, userOpName) |> Async2.toAsync + this.FindReferencesInFile(fileName, projectSnapshot.ToOptions(), symbol, true, userOpName) + |> Async2.toAsync member _.FrameworkImportsCache: FrameworkImportsCache = self.FrameworkImportsCache @@ -1531,17 +1534,20 @@ type internal BackgroundCompiler member _.GetBackgroundCheckResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync + self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) + |> Async2.toAsync member _.GetBackgroundParseResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync + self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + |> Async2.toAsync member _.GetCachedCheckFileResult (builder: IncrementalBuilder, fileName: string, sourceText: ISourceText, options: FSharpProjectOptions) : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = - self.GetCachedCheckFileResult(builder, fileName, sourceText, options) |> Async2.toAsync + self.GetCachedCheckFileResult(builder, fileName, sourceText, options) + |> Async2.toAsync member _.GetProjectOptionsFromScript ( @@ -1613,12 +1619,14 @@ type internal BackgroundCompiler member _.GetSemanticClassificationForFile (fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.GetSemanticClassificationForFile(fileName, options, userOpName) |> Async2.toAsync + self.GetSemanticClassificationForFile(fileName, options, userOpName) + |> Async2.toAsync member _.GetSemanticClassificationForFile (fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string) : Async = - self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) |> Async2.toAsync + self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) + |> Async2.toAsync member _.InvalidateConfiguration(options: FSharpProjectOptions, userOpName: string) : unit = self.InvalidateConfiguration(options, userOpName) @@ -1636,7 +1644,8 @@ type internal BackgroundCompiler member _.ParseAndCheckFileInProject (fileName: string, fileVersion: int, sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string) : Async = - self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync + self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + |> Async2.toAsync member _.ParseAndCheckFileInProject (fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) @@ -1649,14 +1658,17 @@ type internal BackgroundCompiler let! sourceText = fileSnapshot.GetSource() |> Async.AwaitTask let options = projectSnapshot.ToOptions() - return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) |> Async2.toAsync + return! + self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) + |> Async2.toAsync } member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async = self.ParseAndCheckProject(options, userOpName) |> Async2.toAsync member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = - self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) |> Async2.toAsync + self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) + |> Async2.toAsync member _.ParseFile (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) @@ -1666,7 +1678,8 @@ type internal BackgroundCompiler member _.ParseFile(fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) = let options = projectSnapshot.ToOptions() - self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync + self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + |> Async2.toAsync member _.ProjectChecked: IEvent = self.ProjectChecked diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 9589916a22..8aefb7f825 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -46,7 +46,7 @@ type DelayedILModuleReader = /// Will lazily create the ILModuleReader. /// Is only evaluated once and can be called by multiple threads. - member internal TryGetILModuleReader: unit -> IAsync2 + member internal TryGetILModuleReader: unit -> Async2 /// Unused in this API type public FSharpUnresolvedReferencesSet = internal FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list @@ -501,7 +501,7 @@ type public FSharpCheckFileResults = parseErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool -> - IAsync2 + Async2 /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -618,7 +618,7 @@ type internal FsiInteractiveChecker = member internal ParseAndCheckInteraction: sourceText: ISourceText * ?userOpName: string -> - IAsync2 + Async2 module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 82d5fd0a70..8bad2ef61c 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -247,7 +247,7 @@ type BoundModel private ( ?tcStateOpt: GraphNode * GraphNode ) = - let getTypeCheck (syntaxTree: SyntaxTree) : IAsync2 = + let getTypeCheck (syntaxTree: SyntaxTree) : Async2 = async2 { let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 76ff8cb5a3..733e7467c8 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -3,18 +3,19 @@ open System open System.Threading open System.Threading.Tasks +open System.Runtime.CompilerServices #nowarn 3513 -type internal IAsync2<'t> = - abstract Start: unit -> Task<'t> +type internal Async2<'t> = + abstract Start: unit -> Task<'t> + abstract GetAwaiter: unit -> TaskAwaiter<'t> module internal Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.CompilerServices - open System.Runtime.CompilerServices open System.Runtime.ExceptionServices let failIfNot condition message = @@ -30,16 +31,14 @@ module internal Async2Implementation = let currentContext = AsyncLocal() - type Invokable<'Async2, 'TResult - when 'Async2: (member Start: unit -> Task<'TResult>)> = 'Async2 - /// A structure that looks like an Awaiter - type Awaiter<'Awaiter, 'TResult + type internal Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion and 'Awaiter: (member get_IsCompleted: unit -> bool) and 'Awaiter: (member GetResult: unit -> 'TResult)> = 'Awaiter - type Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable + type internal Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = + 'Awaitable module Awaiter = let inline isCompleted (awaiter: ^Awaiter) : bool when ^Awaiter: (member get_IsCompleted: unit -> bool) = awaiter.get_IsCompleted () @@ -152,13 +151,14 @@ module internal Async2Implementation = Throw exn [] - type Async2<'T>(start: unit -> Task<'T>) = + type Async2Impl<'T>(start: unit -> Task<'T>) = - interface IAsync2<'T> with + interface Async2<'T> with member _.Start() = start () + member _.GetAwaiter() = (start ()).GetAwaiter() - //static let tailCallSource = AsyncLocal voption>() + //static let tailCallSource = AsyncLocal voption>() [] type Async2Data<'t> = @@ -176,16 +176,14 @@ module internal Async2Implementation = [] module Async2Code = - let inline filterCancellation (catch: exn -> Async2Code<_, _>) (exn: exn) = + let inline filterCancellation ([] catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> - raise exn + | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> raise exn | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: Async2Code<_, _>) = Async2Code(fun sm -> - if currentContext.Value.Token.IsCancellationRequested then printfn "throwing cancellation" currentContext.Value.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) @@ -281,7 +279,7 @@ module internal Async2Implementation = [] member inline this.ReturnFrom(awaiter) : Async2Code<'T, 'T> = this.Bind(awaiter, this.Return) - static member inline RunDynamic(code: Async2Code<'T, 'T>) : IAsync2<'T> = + static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) let resumptionInfo () = @@ -329,7 +327,7 @@ module internal Async2Implementation = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2(fun () -> + Async2Impl(fun () -> let mutable copy = Async2StateMachine() copy.ResumptionDynamicInfo <- resumptionInfo () copy.Data <- Async2Data() @@ -337,7 +335,7 @@ module internal Async2Implementation = copy.Data.MethodBuilder.Start(©) copy.Data.MethodBuilder.Task) - member inline _.Run(code: Async2Code<'T, 'T>) : IAsync2<'T> = + member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then __stateMachine, _> @@ -368,9 +366,10 @@ module internal Async2Implementation = (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) (AfterCode<_, _>(fun sm -> - let mutable copy = sm + let sm = sm - Async2(fun () -> + Async2Impl(fun () -> + let mutable copy = sm copy.Data <- Async2Data() copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() copy.Data.MethodBuilder.Start(©) @@ -378,7 +377,7 @@ module internal Async2Implementation = else Async2Builder.RunDynamic(code) - member inline _.Source(code: IAsync2<_>) = code.Start().GetAwaiter() + member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() [] module internal Async2AutoOpens = @@ -393,8 +392,10 @@ module internal Async2LowPriority = type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() - member inline _.Source(expr: Async<_>) = - Async.StartAsTask(expr, cancellationToken = currentContext.Value.Token).GetAwaiter() + member inline this.Source(expr: Async<'T>) = + let ct = currentContext.Value.Token + let t = Async.StartAsTask(expr, cancellationToken = ct) + this.Source(t.ConfigureAwait(false)) member inline _.Source(items: #seq<_>) : seq<_> = upcast items @@ -403,8 +404,8 @@ module internal Async2MediumPriority = open Async2Implementation type Async2Builder with - member inline _.Source(task: Task) = task.GetAwaiter() - member inline _.Source(task: Task<_>) = task.GetAwaiter() + member inline _.Source(task: Task) = task.ConfigureAwait(false).GetAwaiter() + member inline _.Source(task: Task<_>) = task.ConfigureAwait(false).GetAwaiter() open Async2Implementation @@ -429,19 +430,17 @@ type internal Async2 = module internal Async2 = - let inline start (code: IAsync2<_>) = code.Start() - - let inline startWithContext context code = + let inline startWithContext context (code: Async2<_>) = let old = currentContext.Value currentContext.Value <- context try BindContext.ResetBindCount() - start code + code.Start() finally currentContext.Value <- old - let run ct (code: IAsync2<'t>) = + let run ct (code: Async2<'t>) = let context = { Token = ct; IsNested = true } if @@ -454,14 +453,24 @@ module internal Async2 = let runWithoutCancellation code = run CancellationToken.None code - let toAsync (code: IAsync2<'t>) = + let startAsTaskWithoutCancellation code = + startWithContext + { + Token = CancellationToken.None + IsNested = true + } + code + + let startAsTask ct code = + startWithContext { Token = ct; IsNested = false } code + let toAsync (code: Async2<'t>) = async { let! ct = Async.CancellationToken - return! Async.FromContinuations <| fun (cont, econt, ccont) -> - try - cont (run ct code) - with - | :? OperationCanceledException as oce when oce.CancellationToken = ct -> ccont oce - | exn -> econt exn + let task = startAsTask ct code + return! Async.AwaitTask task } + + let fromValue (value: 't) : Async2<'t> = + let task = Task.FromResult value + Async2Impl(fun () -> task) diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 9f6e95ae95..2a7a0afe3b 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -12,534 +12,546 @@ open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics -//module BuildGraphTests = +module BuildGraphTests = -// [] -// let private createNode () = -// let o = obj () -// GraphNode(async { -// Assert.shouldBeTrue (o <> null) -// return 1 -// }), WeakReference(o) + [] + let private createNode () = + let o = obj () + GraphNode(async2 { + Assert.shouldBeTrue (o <> null) + return 1 + }), WeakReference(o) -// [] -// let ``Initialization of graph node should not have a computed value``() = -// let node = GraphNode(async { return 1 }) -// Assert.shouldBeTrue(node.TryPeekValue().IsNone) -// Assert.shouldBeFalse(node.HasValue) + // Robust GC helpers for .NET 10 timing differences + let private forceFullGc () = + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + GC.WaitForPendingFinalizers() + GC.Collect(2, GCCollectionMode.Forced, blocking = true) -// [] -// let ``Two requests to get a value asynchronously should be successful``() = -// let resetEvent = new ManualResetEvent(false) -// let resetEventInAsync = new ManualResetEvent(false) + let private timeoutMs = 10_000 -// let graphNode = -// GraphNode(async { -// resetEventInAsync.Set() |> ignore -// let! _ = Async.AwaitWaitHandle(resetEvent) -// return 1 -// }) + let private assertEventuallyCollected (wr: WeakReference) = + let sw = Diagnostics.Stopwatch.StartNew() + let mutable alive = true + while alive && sw.ElapsedMilliseconds < int64 timeoutMs do + forceFullGc () + alive <- wr.IsAlive + if alive then Thread.Sleep 10 + Assert.shouldBeFalse wr.IsAlive -// let task1 = -// async { -// let! _ = graphNode.GetOrComputeValue() -// () -// } |> Async.StartAsTask + [] + let ``Initialization of graph node should not have a computed value``() = + let node = GraphNode(async2 { return 1 }) + Assert.shouldBeTrue(node.TryPeekValue().IsNone) + Assert.shouldBeFalse(node.HasValue) -// let task2 = -// async { -// let! _ = graphNode.GetOrComputeValue() -// () -// } |> Async.StartAsTask + [] + let ``Two requests to get a value asynchronously should be successful``() = + let resetEvent = new ManualResetEvent(false) + let resetEventInAsync = new ManualResetEvent(false) -// resetEventInAsync.WaitOne() |> ignore -// resetEvent.Set() |> ignore -// try -// task1.Wait(1000) |> ignore -// task2.Wait() |> ignore -// with -// | :? TimeoutException -> reraise() -// | _ -> () + let graphNode = + GraphNode(async2 { + resetEventInAsync.Set() |> ignore + let! _ = Async.AwaitWaitHandle(resetEvent) + return 1 + }) -// [] -// let ``Many requests to get a value asynchronously should only evaluate the computation once``() = -// let requests = 10000 -// let mutable computationCount = 0 + let task1 = + graphNode.GetOrComputeValue() |> Async2.startAsTaskWithoutCancellation -// let graphNode = -// GraphNode(async { -// computationCount <- computationCount + 1 -// return 1 -// }) -// let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) + let task2 = + graphNode.GetOrComputeValue() |> Async2.startAsTaskWithoutCancellation -// Async.RunImmediate(work) -// |> ignore + resetEventInAsync.WaitOne() |> ignore + resetEvent.Set() |> ignore + try + task1.Wait(1000) |> ignore + task2.Wait(1000) |> ignore + with + | :? TimeoutException -> reraise() + | _ -> () -// Assert.shouldBe 1 computationCount + [] + let ``Many requests to get a value asynchronously should only evaluate the computation once``() = + let requests = 10000 + let mutable computationCount = 0 -// [] -// let ``Many requests to get a value asynchronously should get the correct value``() = -// let requests = 10000 + let graphNode = + GraphNode(async2 { + computationCount <- computationCount + 1 + return 1 + }) -// let graphNode = GraphNode(async { return 1 }) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync )) -// let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) + Async.RunImmediate(work) + |> ignore -// let result = Async.RunImmediate(work) + Assert.shouldBe 1 computationCount -// Assert.shouldNotBeEmpty result -// Assert.shouldBe requests result.Length -// result -// |> Seq.iter (Assert.shouldBe 1) + [] + let ``Many requests to get a value asynchronously should get the correct value``() = + let requests = 10000 -// [] -// let ``A request to get a value asynchronously should have its computation cleaned up by the GC``() = -// let graphNode, weak = createNode () + let graphNode = GraphNode(async2 { return 1 }) -// GC.Collect(2, GCCollectionMode.Forced, true) + let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync )) -// Assert.shouldBeTrue weak.IsAlive + let result = Async.RunImmediate(work) -// Async.RunImmediate(graphNode.GetOrComputeValue()) -// |> ignore + Assert.shouldNotBeEmpty result + Assert.shouldBe requests result.Length + result + |> Seq.iter (Assert.shouldBe 1) -// GC.Collect(2, GCCollectionMode.Forced, true) + [] + let ``A request to get a value asynchronously should have its computation cleaned up by the GC``() = + let graphNode, weak = createNode () -// Assert.shouldBeFalse weak.IsAlive + GC.Collect(2, GCCollectionMode.Forced, true) -// [] -// let ``Many requests to get a value asynchronously should have its computation cleaned up by the GC``() = -// let requests = 10000 + Assert.shouldBeTrue weak.IsAlive -// let graphNode, weak = createNode () + Async2.runWithoutCancellation(graphNode.GetOrComputeValue()) + |> ignore -// GC.Collect(2, GCCollectionMode.Forced, true) + GC.Collect(2, GCCollectionMode.Forced, true) + + assertEventuallyCollected weak + + [] + let ``Many requests to get a value asynchronously should have its computation cleaned up by the GC``() = + let requests = 10000 + + let graphNode, weak = createNode () + + GC.Collect(2, GCCollectionMode.Forced, true) -// Assert.shouldBeTrue weak.IsAlive - -// 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 { -// return 1 -// }) - -// use cts = new CancellationTokenSource() - -// let work = -// 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 - -// Assert.shouldBeTrue(ex <> null) - -// [] -// let ``A request can cancel 2``() = -// let resetEvent = new ManualResetEvent(false) - -// let graphNode = -// GraphNode(async { -// let! _ = Async.AwaitWaitHandle(resetEvent) -// return 1 -// }) - -// use cts = new CancellationTokenSource() - -// 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 - -// 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``() = -// let requests = 10000 -// let resetEvent = new ManualResetEvent(false) -// let mutable computationCountBeforeSleep = 0 -// let mutable computationCount = 0 - -// let graphNode = -// GraphNode(async { -// computationCountBeforeSleep <- computationCountBeforeSleep + 1 -// let! _ = Async.AwaitWaitHandle(resetEvent) -// computationCount <- computationCount + 1 -// return 1 -// }) - -// use cts = new CancellationTokenSource() - -// let work = -// async { -// let! _ = graphNode.GetOrComputeValue() -// () -// } - -// let tasks = ResizeArray() - -// for i = 0 to requests - 1 do -// if i % 10 = 0 then -// Async.StartAsTask(work, cancellationToken = cts.Token) -// |> tasks.Add -// else -// Async.StartAsTask(work) -// |> tasks.Add - -// cts.Cancel() -// resetEvent.Set() |> ignore -// Async.RunImmediate(work) -// |> ignore - -// Assert.shouldBeTrue cts.IsCancellationRequested -// Assert.shouldBeTrue(computationCountBeforeSleep > 0) -// Assert.shouldBeTrue(computationCount >= 0) - -// tasks -// |> Seq.iter (fun x -> -// try x.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> ()) - -// [] -// let ``GraphNode created from an already computed result will return it in tryPeekValue`` () = -// let graphNode = GraphNode.FromResult 1 - -// Assert.shouldBeTrue graphNode.HasValue -// Assert.shouldBe (ValueSome 1) (graphNode.TryPeekValue()) - -// type ExampleException(msg) = inherit System.Exception(msg) - -// [] -// let internal ``DiagnosticsThreadStatics preserved in async`` () = -// let random = -// let rng = Random() -// fun n -> rng.Next n + Assert.shouldBeTrue weak.IsAlive + + Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync ))) + |> ignore + + GC.Collect(2, GCCollectionMode.Forced, true) + + assertEventuallyCollected weak + + [] + let ``A request can cancel``() = + let graphNode = + GraphNode(async2 { + return 1 + }) + + use cts = new CancellationTokenSource() + + let work = + async2 { + cts.Cancel() + return! graphNode.GetOrComputeValue() + } + + let ex = + try + Async2.run cts.Token work + |> ignore + failwith "Should have canceled" + with + | :? OperationCanceledException as ex -> + ex + + Assert.shouldBeTrue(ex <> null) + + [] + let ``A request can cancel 2``() = + let resetEvent = new ManualResetEvent(false) + + let graphNode = + GraphNode(async2 { + let! _ = Async.AwaitWaitHandle(resetEvent) + return 1 + }) + + use cts = new CancellationTokenSource() + + let task = + async { + cts.Cancel() + resetEvent.Set() |> ignore + } + |> Async.StartAsTask + + let ex = + try + Async2.run cts.Token <| graphNode.GetOrComputeValue() + |> ignore + failwith "Should have canceled" + with + | :? OperationCanceledException as ex -> + ex + + 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``() = + let requests = 10000 + let resetEvent = new ManualResetEvent(false) + let mutable computationCountBeforeSleep = 0 + let mutable computationCount = 0 + + let graphNode = + GraphNode(async2 { + computationCountBeforeSleep <- computationCountBeforeSleep + 1 + let! _ = Async.AwaitWaitHandle(resetEvent) + computationCount <- computationCount + 1 + return 1 + }) + + use cts = new CancellationTokenSource() + + let work = + async { + let! _ = graphNode.GetOrComputeValue() |> Async2.toAsync + () + } + + let tasks = ResizeArray() + + for i = 0 to requests - 1 do + if i % 10 = 0 then + Async.StartAsTask(work, cancellationToken = cts.Token) + |> tasks.Add + else + Async.StartAsTask(work) + |> tasks.Add + + cts.Cancel() + resetEvent.Set() |> ignore + Async.RunImmediate(work) + |> ignore + + Assert.shouldBeTrue cts.IsCancellationRequested + Assert.shouldBeTrue(computationCountBeforeSleep > 0) + Assert.shouldBeTrue(computationCount >= 0) + + tasks + |> Seq.iter (fun x -> + try x.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> ()) + + [] + let ``GraphNode created from an already computed result will return it in tryPeekValue`` () = + let graphNode = GraphNode.FromResult 1 + + Assert.shouldBeTrue graphNode.HasValue + Assert.shouldBe (ValueSome 1) (graphNode.TryPeekValue()) + + type ExampleException(msg) = inherit System.Exception(msg) + + [] + 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 -// Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) -// DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() -// |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" - -// errorR (ExampleException $"job {i}") -// } + 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}") + } -// let work (phase: BuildPhase) = -// async { -// let n = 8 -// let logger = CapturingDiagnosticsLogger("test NodeCode") -// use _ = new CompilationGlobalsScope(logger, phase) -// let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel + let work (phase: BuildPhase) = + async { + let n = 8 + let logger = CapturingDiagnosticsLogger("test NodeCode") + use _ = new CompilationGlobalsScope(logger, phase) + let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel -// let diags = logger.Diagnostics |> List.map fst + let diags = logger.Diagnostics |> List.map fst -// diags |> List.map _.Phase |> List.distinct |> Assert.shouldBe [ phase ] -// diags |> List.map _.Exception.Message -// |> Assert.shouldBe (List.init n <| sprintf "job %d") + diags |> List.map _.Phase |> List.distinct |> Assert.shouldBe [ phase ] + diags |> List.map _.Exception.Message + |> Assert.shouldBe (List.init n <| sprintf "job %d") -// Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) -// } + Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) + } -// let phases = [| -// BuildPhase.DefaultPhase -// BuildPhase.Compile -// BuildPhase.Parameter -// BuildPhase.Parse -// BuildPhase.TypeCheck -// BuildPhase.CodeGen -// BuildPhase.Optimize -// BuildPhase.IlxGen -// BuildPhase.IlGen -// BuildPhase.Output -// BuildPhase.Interactive -// |] + let phases = [| + BuildPhase.DefaultPhase + BuildPhase.Compile + BuildPhase.Parameter + BuildPhase.Parse + BuildPhase.TypeCheck + BuildPhase.CodeGen + BuildPhase.Optimize + BuildPhase.IlxGen + BuildPhase.IlGen + BuildPhase.Output + BuildPhase.Interactive + |] -// let pickRandomPhase _ = phases[random phases.Length] -// Seq.init 100 pickRandomPhase -// |> Seq.map work -// |> Async.Parallel -// |> Async.RunSynchronously + let pickRandomPhase _ = phases[random phases.Length] + Seq.init 100 pickRandomPhase + |> Seq.map work + |> Async.Parallel + |> Async.RunSynchronously -// exception TestException + exception TestException -// type internal SimpleConcurrentLogger(name) = -// inherit DiagnosticsLogger(name) + type internal SimpleConcurrentLogger(name) = + inherit DiagnosticsLogger(name) -// let mutable errorCount = 0 + let mutable errorCount = 0 -// override _.DiagnosticSink(d, s) = -// if s = FSharpDiagnosticSeverity.Error then Interlocked.Increment(&errorCount) |> ignore + override _.DiagnosticSink(d, s) = + if s = FSharpDiagnosticSeverity.Error then Interlocked.Increment(&errorCount) |> ignore -// override this.ErrorCount = errorCount + override this.ErrorCount = errorCount -// let loggerShouldBe logger = -// DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger + let loggerShouldBe logger = + DiagnosticsThreadStatics.DiagnosticsLogger |> Assert.shouldBe logger -// let errorCountShouldBe ec = -// DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec + let errorCountShouldBe ec = + DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount |> Assert.shouldBe ec -// [] -// let ``AsyncLocal diagnostics context works with TPL`` () = + [] + let ``AsyncLocal diagnostics context works with TPL`` () = -// let task1 () = -// List.init 20 (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 task1 () = + List.init 20 (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 + let task2 () = + let commonLogger = SimpleConcurrentLogger "ListParallel concurrent logger" + use _ = UseDiagnosticsLogger commonLogger -// [1 .. 20] -// |> Extras.ListParallel.map (fun _ -> -// for _ in 1 .. 10 do -// errorR TestException -// Thread.Sleep 5 -// loggerShouldBe commonLogger ) -// |> ignore -// errorCountShouldBe 200 -// loggerShouldBe commonLogger + [1 .. 20] + |> Extras.ListParallel.map (fun _ -> + for _ in 1 .. 10 do + errorR TestException + Thread.Sleep 5 + loggerShouldBe commonLogger ) + |> ignore + errorCountShouldBe 200 + loggerShouldBe commonLogger -// Tasks.Parallel.Invoke(task1, task2) + 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 + 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 ``MultipleDiagnosticsLoggers capture diagnostics in correct order`` () = -// let mutable prevError = "000." + let mutable prevError = "000." -// let errorCommitted msg = -// // errors come in correct order -// Assert.shouldBeTrue (msg > prevError) -// prevError <- msg + 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 work i = async { + for c in 'A' .. 'F' do + do! Async.SwitchToThreadPool() + errorR (ExampleException $"%03d{i}{c}") + } -// let tasks = Seq.init 100 work + let tasks = Seq.init 100 work -// let logger = DiagnosticsLoggerWithCallback errorCommitted -// use _ = UseDiagnosticsLogger logger -// tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate + let logger = DiagnosticsLoggerWithCallback errorCommitted + use _ = UseDiagnosticsLogger logger + tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate -// // all errors committed -// errorCountShouldBe 300 + // all errors committed + errorCountShouldBe 300 -// tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate + tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate -// errorCountShouldBe 600 + errorCountShouldBe 600 -// [] -// let ``MultipleDiagnosticsLoggers.Parallel finishes when any computation throws`` () = + [] + let ``MultipleDiagnosticsLoggers.Parallel finishes when any computation throws`` () = -// let mutable count = 0 -// use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger") + let mutable count = 0 + use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger") -// let tasks = [ -// async { failwith "computation failed" } + let tasks = [ + async { failwith "computation failed" } -// for i in 1 .. 300 do -// async { -// errorR (ExampleException $"{Interlocked.Increment(&count)}") -// error (ExampleException $"{Interlocked.Increment(&count)}") -// } -// ] + for i in 1 .. 300 do + async { + errorR (ExampleException $"{Interlocked.Increment(&count)}") + error (ExampleException $"{Interlocked.Increment(&count)}") + } + ] -// task { -// do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore + task { + do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore -// // Diagnostics from all started tasks should be collected despite the exception. -// errorCountShouldBe count -// } + // Diagnostics from all started tasks should be collected despite the exception. + errorCountShouldBe count + } -// [] -// let ``AsyncLocal diagnostics context flows correctly`` () = + [] + let ``AsyncLocal diagnostics context flows correctly`` () = -// let work logger = async { -// SetThreadDiagnosticsLoggerNoUnwind logger + let work logger = async { + SetThreadDiagnosticsLoggerNoUnwind logger -// errorR TestException + errorR TestException -// loggerShouldBe logger -// errorCountShouldBe 1 + loggerShouldBe logger + errorCountShouldBe 1 -// do! Async.SwitchToNewThread() + do! Async.SwitchToNewThread() -// errorR TestException + errorR TestException -// loggerShouldBe logger -// errorCountShouldBe 2 + loggerShouldBe logger + errorCountShouldBe 2 -// do! Async.SwitchToThreadPool() + do! Async.SwitchToThreadPool() -// errorR TestException + errorR TestException -// loggerShouldBe logger -// errorCountShouldBe 3 + loggerShouldBe logger + errorCountShouldBe 3 -// let workInner = async { -// do! async.Zero() -// errorR TestException -// loggerShouldBe logger -// } + let workInner = async { + do! async.Zero() + errorR TestException + loggerShouldBe logger + } -// let! child = workInner |> Async.StartChild -// let! childTask = workInner |> Async.StartChildAsTask + let! child = workInner |> Async.StartChild + let! childTask = workInner |> Async.StartChildAsTask -// do! child -// do! childTask |> Async.AwaitTask -// errorCountShouldBe 5 -// } + 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 noErrorsTask = backgroundTask { -// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger -// errorR TestException -// do! Task.Yield() -// errorR TestException -// loggerShouldBe DiscardErrorsLogger -// } - -// let task = task { -// errorR TestException -// do! Task.Yield() -// errorR TestException -// 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 -// )) -// thread.Start() -// thread.Join() - -// Task.WaitAll(noErrorsTask, btask, task) - -// Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore - -// loggerShouldBe logger -// errorCountShouldBe 17 - -// async { - -// // After Async.Parallel the continuation runs in the context of the last computation that finished. -// do! -// [ async { -// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] -// |> Async.Parallel -// |> Async.Ignore -// loggerShouldBe DiscardErrorsLogger - -// SetThreadDiagnosticsLoggerNoUnwind logger - -// // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. -// do! -// [ async { -// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] -// |> MultipleDiagnosticsLoggers.Parallel -// |> Async.Ignore -// loggerShouldBe logger -// } -// |> Async.RunImmediate - -// // Synchronous code will affect current context: - -// // This is synchronous, caller's context is affected -// async { -// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger -// do! Async.SwitchToNewThread() -// loggerShouldBe DiscardErrorsLogger -// } -// |> Async.RunImmediate -// loggerShouldBe DiscardErrorsLogger - -// SetThreadDiagnosticsLoggerNoUnwind logger -// // This runs in async continuation, so the context is forked. -// async { -// do! Async.Sleep 0 -// SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger -// do! Async.SwitchToNewThread() -// loggerShouldBe DiscardErrorsLogger -// } -// |> Async.RunImmediate -// loggerShouldBe logger + 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 noErrorsTask = backgroundTask { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + errorR TestException + do! Task.Yield() + errorR TestException + loggerShouldBe DiscardErrorsLogger + } + + let task = task { + errorR TestException + do! Task.Yield() + errorR TestException + 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 + )) + thread.Start() + thread.Join() + + Task.WaitAll(noErrorsTask, btask, task) + + Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore + + loggerShouldBe logger + errorCountShouldBe 17 + + async { + + // After Async.Parallel the continuation runs in the context of the last computation that finished. + do! + [ async { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] + |> Async.Parallel + |> Async.Ignore + loggerShouldBe DiscardErrorsLogger + + SetThreadDiagnosticsLoggerNoUnwind logger + + // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. + do! + [ async { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] + |> MultipleDiagnosticsLoggers.Parallel + |> Async.Ignore + loggerShouldBe logger + } + |> Async.RunImmediate + + // Synchronous code will affect current context: + + // This is synchronous, caller's context is affected + async { + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + do! Async.SwitchToNewThread() + loggerShouldBe DiscardErrorsLogger + } + |> Async.RunImmediate + loggerShouldBe DiscardErrorsLogger + + SetThreadDiagnosticsLoggerNoUnwind logger + // This runs in async continuation, so the context is forked. + async { + do! Async.Sleep 0 + SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger + do! Async.SwitchToNewThread() + loggerShouldBe DiscardErrorsLogger + } + |> Async.RunImmediate + loggerShouldBe logger diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index c85db73b63..b87d3a3c8a 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -61,6 +61,12 @@ + + Async2.fs + + + BuildGraph.fs + From cb5531b6f4c40f54c2dd2fc0cae19a6edf590056 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 6 Sep 2025 12:04:16 +0200 Subject: [PATCH 21/48] add comment --- src/Compiler/Service/BackgroundCompiler.fs | 2 -- src/Compiler/Utilities/Async2.fs | 3 +++ 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 595ff02f40..d9a070c035 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -503,8 +503,6 @@ type internal BackgroundCompiler let getOrCreateBuilder (options, userOpName) : Async2 = async2 { - use! _holder = Async2.UseTokenAsync() - match tryGetBuilder options with | Some getBuilder -> match! getBuilder with diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 733e7467c8..1066a733b5 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -435,6 +435,9 @@ module internal Async2 = currentContext.Value <- context try + // Only bound computations can participate in trampolining, otherwise we risk sync over async deadlocks. + // To prevent this, we reset the bind count here. + // This computation will not initially bounce, even if it is nested inside another async2 computation. BindContext.ResetBindCount() code.Start() finally From e0a2c3f01a0004c92fe65689a8f47e99d6645207 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 6 Sep 2025 12:06:29 +0200 Subject: [PATCH 22/48] remove unused --- src/Compiler/Utilities/Async2.fs | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 1066a733b5..bd21f2387d 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -23,11 +23,7 @@ module internal Async2Implementation = failwith message [] - type Context = - { - Token: CancellationToken - IsNested: bool - } + type Context = { Token: CancellationToken } let currentContext = AsyncLocal() @@ -444,7 +440,7 @@ module internal Async2 = currentContext.Value <- old let run ct (code: Async2<'t>) = - let context = { Token = ct; IsNested = true } + let context = { Token = ct } if isNull SynchronizationContext.Current @@ -457,15 +453,9 @@ module internal Async2 = let runWithoutCancellation code = run CancellationToken.None code let startAsTaskWithoutCancellation code = - startWithContext - { - Token = CancellationToken.None - IsNested = true - } - code - - let startAsTask ct code = - startWithContext { Token = ct; IsNested = false } code + startWithContext { Token = CancellationToken.None } code + + let startAsTask ct code = startWithContext { Token = ct } code let toAsync (code: Async2<'t>) = async { From 2fd40bcebce9700517ac50092f71797e5bc73b62 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 6 Sep 2025 13:21:03 +0200 Subject: [PATCH 23/48] fix --- src/Compiler/Utilities/Async2.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index bd21f2387d..9b746371c1 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -263,7 +263,6 @@ module internal Async2Implementation = let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) if __stack_yield_fin then - BindContext.ResetBindCount() continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) else let mutable __stack_awaiter = awaiter From d71889759191303440e4950daab6b5d36dee67de Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 7 Sep 2025 17:33:45 +0200 Subject: [PATCH 24/48] wip --- src/Compiler/Driver/CompilerConfig.fs | 2 +- src/Compiler/Driver/CompilerConfig.fsi | 3 +- src/Compiler/Driver/CompilerImports.fs | 26 +-- src/Compiler/Driver/CompilerImports.fsi | 6 +- .../Driver/GraphChecking/GraphProcessing.fs | 164 +++++++----------- .../Driver/GraphChecking/GraphProcessing.fsi | 6 +- src/Compiler/Driver/fsc.fs | 4 +- src/Compiler/Facilities/AsyncMemoize.fs | 43 +++-- src/Compiler/Facilities/AsyncMemoize.fsi | 7 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 6 +- src/Compiler/Facilities/DiagnosticsLogger.fsi | 6 +- src/Compiler/Interactive/fsi.fs | 2 +- src/Compiler/Service/BackgroundCompiler.fs | 125 ++++++------- src/Compiler/Service/BackgroundCompiler.fsi | 44 ++--- src/Compiler/Service/FSharpCheckerResults.fsi | 2 - src/Compiler/Service/FSharpSource.fs | 13 +- src/Compiler/Service/FSharpSource.fsi | 3 +- src/Compiler/Service/IncrementalBuild.fs | 10 +- src/Compiler/Service/IncrementalBuild.fsi | 5 +- src/Compiler/Service/ServiceAnalysis.fs | 17 +- src/Compiler/Service/TransparentCompiler.fs | 154 ++++++++-------- src/Compiler/Service/TransparentCompiler.fsi | 9 +- src/Compiler/Service/service.fs | 45 ++--- src/Compiler/Utilities/Async2.fs | 62 ++++++- .../CompilerService/AsyncMemoize.fs | 59 +++---- .../FSharp.Compiler.ComponentTests.fsproj | 18 +- ...iler.Service.SurfaceArea.netstandard20.bsl | 2 + .../LanguageService/WorkspaceExtensions.fs | 4 +- 28 files changed, 436 insertions(+), 411 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index cccbcb1581..723ac15617 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -296,7 +296,7 @@ and IProjectReference = abstract FileName: string /// Evaluate raw contents of the assembly file generated by the project - abstract EvaluateRawContents: unit -> Async + abstract EvaluateRawContents: unit -> Async2 /// 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 0e6c25727f..82cd78e36d 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -19,7 +19,6 @@ open FSharp.Compiler.Features open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.Text -open FSharp.Compiler.BuildGraph exception FileNameNotResolved of searchedLocations: string * fileName: string * range: range @@ -89,7 +88,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 -> Async + abstract EvaluateRawContents: unit -> Async2 /// 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 4ab1ca3d7e..264337962d 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2249,14 +2249,14 @@ and [] TcImports // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. member tcImports.TryRegisterAndPrepareToImportReferencedDll (ctok, r: AssemblyResolution) - : Async<(_ * (unit -> AvailableImportedAssembly list)) option> = - async { + : Async2<(_ * (unit -> AvailableImportedAssembly list)) option> = + async2 { CheckDisposed() let m = r.originalReference.Range let fileName = r.resolvedPath let! contentsOpt = - async { + async2 { match r.ProjectReference with | Some ilb -> return! ilb.EvaluateRawContents() | None -> return ProjectAssemblyDataResult.Unavailable true @@ -2319,20 +2319,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) = - async { + async2 { CheckDisposed() let tcConfig = tcConfigP.Get ctok let runMethod = match tcConfig.parallelReferenceResolution with - | ParallelReferenceResolution.On -> MultipleDiagnosticsLoggers.Parallel - | ParallelReferenceResolution.Off -> MultipleDiagnosticsLoggers.Sequential + | ParallelReferenceResolution.On -> MultipleDiagnosticsLoggers.Parallel2 + | ParallelReferenceResolution.Off -> MultipleDiagnosticsLoggers.Sequential2 let! results = nms |> List.map (fun nm -> - async { + async2 { try use _ = new CompilationGlobalsScope() return! tcImports.TryRegisterAndPrepareToImportReferencedDll(ctok, nm) @@ -2376,7 +2376,7 @@ and [] TcImports ReportWarnings warns tcImports.RegisterAndImportReferencedAssemblies(ctok, res) - |> Async.RunImmediate + |> Async2.RunImmediate |> ignore true @@ -2466,7 +2466,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) = - async { + async2 { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2543,7 +2543,7 @@ and [] TcImports resolvedAssemblies |> List.choose tryFindEquivPrimaryAssembly let! fslibCcu, fsharpCoreAssemblyScopeRef = - async { + async2 { 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 @@ -2634,7 +2634,7 @@ and [] TcImports (tcConfigP: TcConfigProvider, baseTcImports, nonFrameworkReferences, knownUnresolved, dependencyProvider) = - async { + async2 { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2652,7 +2652,7 @@ and [] TcImports } static member BuildTcImports(tcConfigP: TcConfigProvider, dependencyProvider) = - async { + async2 { let ctok = CompilationThreadToken() let tcConfig = tcConfigP.Get ctok @@ -2684,7 +2684,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) - |> Async.RunImmediate + |> Async2.RunImmediate let asms = ccuinfos diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index 2a95347ecb..0649b70746 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -206,14 +206,14 @@ type TcImports = member internal Base: TcImports option static member BuildFrameworkTcImports: - TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Async + TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Async2 static member BuildNonFrameworkTcImports: TcConfigProvider * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list * DependencyProvider -> - Async + Async2 static member BuildTcImports: - tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> Async + tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> Async2 /// 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/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 33dd1c42c4..c4301b4ef4 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -4,6 +4,7 @@ open System.Threading open FSharp.Compiler.GraphChecking open System.Threading.Tasks open System +open Internal.Utilities.Library /// Information about the node in a graph, describing its relation with other nodes. type NodeInfo<'Item> = @@ -171,123 +172,86 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> (graph: Graph<'Item>) - (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async<'Result>) - : Async<('Item * 'Result)[]> = - async { - let transitiveDeps = graph |> Graph.transitive - let dependents = graph |> Graph.reverse - // Cancellation source used to signal either an exception in one of the items or end of processing. - let! parentCt = Async.CancellationToken - use localCts = new CancellationTokenSource() - - let completionSignal = TaskCompletionSource() - - use _ = parentCt.Register(fun () -> completionSignal.TrySetCanceled() |> ignore) - - use cts = CancellationTokenSource.CreateLinkedTokenSource(parentCt, localCts.Token) - - let makeNode (item: 'Item) : GraphNode<'Item, 'Result> = - let info = - let exists = graph.ContainsKey item - - if - not exists - || not (transitiveDeps.ContainsKey item) - || not (dependents.ContainsKey item) - then - printfn $"Unexpected inconsistent state of the graph for item '{item}'" - - { - Item = item - Deps = graph[item] - TransitiveDeps = transitiveDeps[item] - Dependents = dependents[item] - } + (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async2<'Result>) + : Async2<('Item * 'Result)[]> = + + let transitiveDeps = graph |> Graph.transitive + let dependents = graph |> Graph.reverse + + let makeNode (item: 'Item) : GraphNode<'Item, 'Result> = + let info = + let exists = graph.ContainsKey item + + if + not exists + || not (transitiveDeps.ContainsKey item) + || not (dependents.ContainsKey item) + then + printfn $"Unexpected inconsistent state of the graph for item '{item}'" { - Info = info - Result = None - ProcessedDepsCount = IncrementableInt(0) + Item = item + Deps = graph[item] + TransitiveDeps = transitiveDeps[item] + Dependents = dependents[item] } - let nodes = graph.Keys |> Seq.map (fun item -> item, makeNode item) |> readOnlyDict + { + Info = info + Result = None + ProcessedDepsCount = IncrementableInt(0) + } - let lookupMany items = - items |> Array.map (fun item -> nodes[item]) + let nodes = graph.Keys |> Seq.map (fun item -> item, makeNode item) |> readOnlyDict - let leaves = - nodes.Values |> Seq.filter (fun n -> n.Info.Deps.Length = 0) |> Seq.toArray + let lookupMany items = + items |> Array.map (fun item -> nodes[item]) - let getItemPublicNode item = - let node = nodes[item] + let leaves = + nodes.Values |> Seq.filter (fun n -> n.Info.Deps.Length = 0) |> Seq.toArray - { - ProcessedNode.Info = node.Info - ProcessedNode.Result = - node.Result - |> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available") - } + let getItemPublicNode item = + let node = nodes[item] - let processedCount = IncrementableInt(0) + { + ProcessedNode.Info = node.Info + ProcessedNode.Result = + node.Result + |> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available") + } - let handleExn (item, ex: exn) = + let rec queueNode node = + async2 { try - localCts.Cancel() - with :? ObjectDisposedException -> - // If it's disposed already, it means that the processing has already finished, most likely due to cancellation or failure in another node. - () - - match ex with - | :? OperationCanceledException -> completionSignal.TrySetCanceled() - | _ -> - completionSignal.TrySetException( - GraphProcessingException($"[*] Encountered exception when processing item '{item}': {ex.Message}", ex) - ) - |> ignore - - let incrementProcessedNodesCount () = - if processedCount.Increment() = nodes.Count then - completionSignal.TrySetResult() |> ignore - - let rec queueNode node = - Async.Start( - async { - use! _catch = Async.OnCancel(completionSignal.TrySetCanceled >> ignore) - let! res = processNode node |> Async.Catch - - match res with - | Choice1Of2() -> () - | Choice2Of2 ex -> handleExn (node.Info.Item, ex) - }, - cts.Token - ) - - and processNode (node: GraphNode<'Item, 'Result>) : Async = - async { + do! processNode node + with + | ex -> + return raise (GraphProcessingException($"[*] Encountered exception when processing item '{node.Info.Item}': {ex.Message}", ex)) + } - let info = node.Info + and processNode (node: GraphNode<'Item, 'Result>) : Async2 = + async2 { - let! singleRes = work getItemPublicNode info - node.Result <- Some singleRes + let info = node.Info - let unblockedDependents = - node.Info.Dependents - |> lookupMany - // For every dependent, increment its number of processed dependencies, - // and filter dependents which now have all dependencies processed (but didn't before). - |> Array.filter (fun dependent -> - let pdc = dependent.ProcessedDepsCount.Increment() - // Note: We cannot read 'dependent.ProcessedDepsCount' again to avoid returning the same item multiple times. - pdc = dependent.Info.Deps.Length) + let! singleRes = work getItemPublicNode info + node.Result <- Some singleRes - unblockedDependents |> Array.iter queueNode - incrementProcessedNodesCount () - } + let unblockedDependents = + node.Info.Dependents + |> lookupMany + // For every dependent, increment its number of processed dependencies, + // and filter dependents which now have all dependencies processed (but didn't before). + |> Array.filter (fun dependent -> + let pdc = dependent.ProcessedDepsCount.Increment() + // Note: We cannot read 'dependent.ProcessedDepsCount' again to avoid returning the same item multiple times. + pdc = dependent.Info.Deps.Length) - leaves |> Array.iter queueNode + do! unblockedDependents |> Seq.map queueNode |> Async2.Parallel |> Async2.Ignore + } - // Wait for end of processing, an exception, or an external cancellation request. - do! completionSignal.Task |> Async.AwaitTask + async2 { + do! leaves |> Seq.map queueNode |> Async2.Parallel |> Async2.Ignore // All calculations succeeded - extract the results and sort in input order. return diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi b/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi index 7a8c9f9885..5e8d8bb46b 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi @@ -3,6 +3,8 @@ module internal FSharp.Compiler.GraphChecking.GraphProcessing open System.Threading +open Internal.Utilities.Library + /// Information about the node in a graph, describing its relation with other nodes. type NodeInfo<'Item> = { Item: 'Item @@ -40,5 +42,5 @@ val processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> : val processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> : graph: Graph<'Item> -> - work: (('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async<'Result>) -> - Async<('Item * 'Result)[]> + work: (('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async2<'Result>) -> + Async2<('Item * 'Result)[]> diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 2ef07e66e6..c8f158ade8 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -603,7 +603,7 @@ let main1 // Import basic assemblies let tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) - |> Async.RunImmediate + |> Async2.RunImmediate let ilSourceDocs = [ @@ -651,7 +651,7 @@ let main1 let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) - |> Async.RunImmediate + |> Async2.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 e776fe0aae..9a35e9f87d 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -8,10 +8,11 @@ open System.Runtime.CompilerServices open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library +open System type AsyncLazyState<'t> = - | Initial of computation: Async<'t> - | Running of initialComputation: Async<'t> * work: Task<'t> * CancellationTokenSource * requestCount: int + | Initial of computation: Async2<'t> + | Running of initialComputation: Async2<'t> * work: Task<'t> * CancellationTokenSource * requestCount: int | Completed of result: 't | Faulted of exn @@ -49,16 +50,16 @@ type AsyncLazy<'t> private (initial: AsyncLazyState<'t>, cancelUnawaited: bool, | state -> state // Nothing more to do if state already transitioned. let detachable (work: Task<'t>) = - async { + async2 { try - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken // Using ContinueWith with a CancellationToken allows detaching from the running 'work' task. // If the current async workflow is canceled, the 'work' task will continue running independently. - do! work.ContinueWith(ignore>, ct) |> Async.AwaitTask + do! work.ContinueWith(ignore>, ct) with :? TaskCanceledException -> () // If we're here it means there was no cancellation and the 'work' task has completed. - return! work |> Async.AwaitTask + return! work } let onComplete (t: Task<'t>) = @@ -79,21 +80,21 @@ type AsyncLazy<'t> private (initial: AsyncLazyState<'t>, cancelUnawaited: bool, let cts = new CancellationTokenSource() let work = - Async + Async2 .StartAsTask(computation, cancellationToken = cts.Token) .ContinueWith(onComplete, TaskContinuationOptions.NotOnCanceled) Running(computation, work, cts, 1), detachable work | Running(c, work, cts, count) -> Running(c, work, cts, count + 1), detachable work - | Completed result as state -> state, async { return result } - | Faulted exn as state -> state, async { return raise exn } + | Completed result as state -> state, async2 { return result } + | Faulted exn as state -> state, async2 { return raise exn } // computation will deallocate after state transition to Completed ot Faulted. new(computation, ?cancelUnawaited: bool, ?cacheException) = AsyncLazy(Initial computation, defaultArg cancelUnawaited true, defaultArg cacheException true) member _.Request() = - async { + async2 { try return! withStateUpdate request finally @@ -176,7 +177,7 @@ type private KeyData<'TKey, 'TVersion> = Version: 'TVersion } -type Job<'t> = AsyncLazy * CapturingDiagnosticsLogger> +type internal Job<'t> = AsyncLazy * CapturingDiagnosticsLogger> [] type internal AsyncMemoize<'TKey, 'TVersion, 'TValue @@ -224,19 +225,23 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue } let wrappedComputation = - Async.TryCancelled( - async { + Async2.TryCancelled( + async2 { let sw = Stopwatch.StartNew() log Started key let logger = CapturingDiagnosticsLogger "cache" SetThreadDiagnosticsLoggerNoUnwind logger - match! computation |> Async.Catch with - | Choice1Of2 result -> + try + let! result = computation log Finished key Interlocked.Add(&duration, sw.ElapsedMilliseconds) |> ignore return Result.Ok result, logger - | Choice2Of2 exn -> + with + | :? OperationCanceledException -> + log Canceled key + return Unchecked.defaultof<_> + | exn -> log Failed key return Result.Error exn, logger }, @@ -261,7 +266,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue cached |> Option.map countHit |> Option.defaultWith cacheSetNewJob - async { + async2 { let otherVersions, job = lock cache getOrAdd log Requested key @@ -279,6 +284,10 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue | Error exn -> return raise exn } + member this.GetAsync(key, computation: Async<_>) = + this.Get(key, async2 {return! computation}) + |> Async2.toAsync + member _.TryGet(key: 'TKey, predicate: 'TVersion -> bool) : 'TValue option = lock cache <| fun () -> diff --git a/src/Compiler/Facilities/AsyncMemoize.fsi b/src/Compiler/Facilities/AsyncMemoize.fsi index 1014dfc687..cf7ef30cd6 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fsi +++ b/src/Compiler/Facilities/AsyncMemoize.fsi @@ -1,7 +1,6 @@ namespace Internal.Utilities.Collections -open System.Threading.Tasks -open FSharp.Compiler.BuildGraph +open Internal.Utilities.Library [] module internal Utils = @@ -62,7 +61,9 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue member Clear: predicate: ('TKey -> bool) -> unit - member Get: key: ICacheKey<'TKey, 'TVersion> * computation: Async<'TValue> -> Async<'TValue> + member Get: key: ICacheKey<'TKey, 'TVersion> * computation: Async2<'TValue> -> Async2<'TValue> + + member GetAsync: key: ICacheKey<'TKey, 'TVersion> * computation: Async<'TValue> -> Async<'TValue> member TryGet: key: 'TKey * predicate: ('TVersion -> bool) -> 'TValue option diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 6dc5202f81..e9f725ec25 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -985,8 +985,6 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } - let Sequential2 computations = - computations |> Seq.map Async2.toAsync |> Sequential + let Sequential2 computations = Async2.Sequential computations - let Parallel2 computations = - computations |> Seq.map Async2.toAsync |> Parallel + let Parallel2 computations = Async2.Parallel computations diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 7a8b915add..ac827d879e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -495,8 +495,10 @@ module MultipleDiagnosticsLoggers = /// 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> - val Parallel2: computations: #Async2<'T> seq -> Async<'T array> + + val Parallel2: computations: Async2<'T> seq -> Async2<'T array> /// Run computations sequentially starting immediately on the current thread. val Sequential: computations: Async<'T> seq -> Async<'T array> - val Sequential2: computations: #Async2<'T> seq -> Async<'T array> + + val Sequential2: computations: Async2<'T> seq -> Async2<'T array> diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index ed1143d386..4bcb2c2451 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4678,7 +4678,7 @@ type FsiEvaluationSession unresolvedReferences, fsiOptions.DependencyProvider ) - |> Async.RunImmediate + |> Async2.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 d9a070c035..e2b5fc7cda 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 -> - Async + Async2 /// 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 -> - Async + Async2 abstract member ClearCache: options: seq * userOpName: string -> unit @@ -83,31 +83,31 @@ type internal IBackgroundCompiler = symbol: FSharp.Compiler.Symbols.FSharpSymbol * canInvalidateProject: bool * userOpName: string -> - Async> + Async2> abstract member FindReferencesInFile: fileName: string * projectSnapshot: FSharpProjectSnapshot * symbol: FSharp.Compiler.Symbols.FSharpSymbol * userOpName: string -> - Async> + Async2> abstract member GetAssemblyData: options: FSharpProjectOptions * outputFileName: string * userOpName: string -> - Async + Async2 abstract member GetAssemblyData: projectSnapshot: FSharpProjectSnapshot * outputFileName: string * userOpName: string -> - Async + Async2 /// 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 -> Async + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async2 /// 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 -> Async + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async2 abstract member GetCachedCheckFileResult: builder: IncrementalBuilder * fileName: string * sourceText: ISourceText * options: FSharpProjectOptions -> - Async<(FSharpParseFileResults * FSharpCheckFileResults) option> + Async2<(FSharpParseFileResults * FSharpCheckFileResults) option> abstract member GetProjectOptionsFromScript: fileName: string * @@ -122,7 +122,7 @@ type internal IBackgroundCompiler = assumeDotNetFramework: bool option * optionsStamp: int64 option * userOpName: string -> - Async + Async2 abstract GetProjectSnapshotFromScript: fileName: string * @@ -138,44 +138,44 @@ type internal IBackgroundCompiler = assumeDotNetFramework: bool option * optionsStamp: int64 option * userOpName: string -> - Async + Async2 abstract member GetSemanticClassificationForFile: fileName: string * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 abstract member GetSemanticClassificationForFile: fileName: string * snapshot: FSharpProjectSnapshot * userOpName: string -> - Async + Async2 abstract member InvalidateConfiguration: options: FSharpProjectOptions * userOpName: string -> unit abstract InvalidateConfiguration: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> unit - abstract member NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async + abstract member NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async2 - abstract member NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async + abstract member NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async2 /// 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 -> - Async + Async2 abstract member ParseAndCheckFileInProject: fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> - Async + Async2 /// Parse and typecheck the whole project. - abstract member ParseAndCheckProject: options: FSharpProjectOptions * userOpName: string -> Async + abstract member ParseAndCheckProject: options: FSharpProjectOptions * userOpName: string -> Async2 - abstract member ParseAndCheckProject: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async + abstract member ParseAndCheckProject: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async2 abstract member ParseFile: fileName: string * sourceText: ISourceText * options: FSharpParsingOptions * cache: bool * flatErrors: bool * userOpName: string -> - Async + Async2 abstract member ParseFile: - fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async + fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async2 /// Try to get recent approximate type check results for a file. abstract member TryGetRecentCheckResultsForFile: @@ -316,7 +316,7 @@ type internal BackgroundCompiler then { new IProjectReference with member x.EvaluateRawContents() = - async { + async2 { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) return! self.GetAssemblyData(opts, userOpName + ".CheckReferencedProject(" + nm + ")") } @@ -343,7 +343,6 @@ type internal BackgroundCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -358,7 +357,6 @@ type internal BackgroundCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -496,7 +494,7 @@ type internal BackgroundCompiler let createAndGetBuilder (options, userOpName) = async2 { - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let getBuilderNode = createBuilderNode (options, userOpName, ct) return! getBuilderNode.GetOrComputeValue() } @@ -580,7 +578,7 @@ type internal BackgroundCompiler member _.ParseFile (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) = - async { + async2 { use _ = Activity.start "BackgroundCompiler.ParseFile" @@ -597,7 +595,7 @@ type internal BackgroundCompiler | Some res -> return res | None -> Interlocked.Increment(&actualParseFileCount) |> ignore - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -617,7 +615,7 @@ type internal BackgroundCompiler parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) return res else - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -713,9 +711,9 @@ type internal BackgroundCompiler tcPrior: PartialCheckResults, tcInfo: TcInfo, creationDiags: FSharpDiagnostic[] - ) : Async = + ) : Async2 = - async { + async2 { // Get additional script #load closure information if applicable. // For scripts, this will have been recorded by GetProjectOptionsFromScript. let tcConfig = tcPrior.TcConfig @@ -909,7 +907,7 @@ type internal BackgroundCompiler ) GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -1250,7 +1248,6 @@ type internal BackgroundCompiler let! _, _, tcAssemblyDataOpt, _ = builder.GetCheckResultsAndImplementationsForProject() return tcAssemblyDataOpt } - |> Async2.toAsync /// Get the timestamp that would be on the output if fully built immediately member private _.TryGetLogicalTimeStampForProject(cache, options) = @@ -1376,7 +1373,6 @@ type internal BackgroundCompiler return options, (diags @ diagnostics.Diagnostics) } - |> Async2.toAsync member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = @@ -1417,9 +1413,9 @@ type internal BackgroundCompiler Activity.Tags.userOpName, userOpName |] - async { + async2 { - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous // builder, but costs some time. @@ -1478,7 +1474,7 @@ type internal BackgroundCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : Async = + ) : Async2 = async2 { ignore parseResults @@ -1486,7 +1482,6 @@ type internal BackgroundCompiler return result } - |> Async2.toAsync member _.CheckFileInProjectAllowingStaleCachedResults ( @@ -1496,9 +1491,8 @@ type internal BackgroundCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : Async = + ) : Async2 = self.CheckFileInProjectAllowingStaleCachedResults(parseResults, fileName, fileVersion, sourceText, options, userOpName) - |> Async2.toAsync member _.ClearCache(options: seq, userOpName: string) : unit = self.ClearCache(options, userOpName) @@ -1511,41 +1505,36 @@ type internal BackgroundCompiler member _.FindReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) - : Async> = + : Async2> = self.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) - |> Async2.toAsync member this.FindReferencesInFile(fileName, projectSnapshot, symbol, userOpName) = this.FindReferencesInFile(fileName, projectSnapshot.ToOptions(), symbol, true, userOpName) - |> Async2.toAsync member _.FrameworkImportsCache: FrameworkImportsCache = self.FrameworkImportsCache - member _.GetAssemblyData(options: FSharpProjectOptions, _fileName: string, userOpName: string) : Async = + member _.GetAssemblyData(options: FSharpProjectOptions, _fileName: string, userOpName: string) : Async2 = self.GetAssemblyData(options, userOpName) member _.GetAssemblyData (projectSnapshot: FSharpProjectSnapshot, _fileName: string, userOpName: string) - : Async = + : Async2 = self.GetAssemblyData(projectSnapshot.ToOptions(), userOpName) member _.GetBackgroundCheckResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = + : Async2 = self.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) - |> Async2.toAsync member _.GetBackgroundParseResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = + : Async2 = self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) - |> Async2.toAsync member _.GetCachedCheckFileResult (builder: IncrementalBuilder, fileName: string, sourceText: ISourceText, options: FSharpProjectOptions) - : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = + : Async2<(FSharpParseFileResults * FSharpCheckFileResults) option> = self.GetCachedCheckFileResult(builder, fileName, sourceText, options) - |> Async2.toAsync member _.GetProjectOptionsFromScript ( @@ -1561,7 +1550,7 @@ type internal BackgroundCompiler assumeDotNetFramework: bool option, optionsStamp: int64 option, userOpName: string - ) : Async = + ) : Async2 = self.GetProjectOptionsFromScript( fileName, sourceText, @@ -1592,8 +1581,8 @@ type internal BackgroundCompiler assumeDotNetFramework: bool option, optionsStamp: int64 option, userOpName: string - ) : Async = - async { + ) : Async2 = + async2 { let! options, diagnostics = self.GetProjectOptionsFromScript( fileName, @@ -1616,15 +1605,13 @@ type internal BackgroundCompiler member _.GetSemanticClassificationForFile (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = + : Async2 = self.GetSemanticClassificationForFile(fileName, options, userOpName) - |> Async2.toAsync member _.GetSemanticClassificationForFile (fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string) - : Async = + : Async2 = self.GetSemanticClassificationForFile(fileName, snapshot.ToOptions(), userOpName) - |> Async2.toAsync member _.InvalidateConfiguration(options: FSharpProjectOptions, userOpName: string) : unit = self.InvalidateConfiguration(options, userOpName) @@ -1633,40 +1620,37 @@ type internal BackgroundCompiler let options = projectSnapshot.ToOptions() self.InvalidateConfiguration(options, userOpName) - member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = - self.NotifyFileChanged(fileName, options, userOpName) |> Async2.toAsync + member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async2 = + self.NotifyFileChanged(fileName, options, userOpName) - member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async = + member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async2 = self.NotifyProjectCleaned(options, userOpName) member _.ParseAndCheckFileInProject (fileName: string, fileVersion: int, sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string) - : Async = + : Async2 = self.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) - |> Async2.toAsync member _.ParseAndCheckFileInProject (fileName: string, projectSnapshot: FSharpProjectSnapshot, userOpName: string) - : Async = - async { + : Async2 = + async2 { let fileSnapshot = projectSnapshot.ProjectSnapshot.SourceFiles |> Seq.find (fun f -> f.FileName = fileName) - let! sourceText = fileSnapshot.GetSource() |> Async.AwaitTask + let! sourceText = fileSnapshot.GetSource() let options = projectSnapshot.ToOptions() return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) - |> Async2.toAsync } - member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async = - self.ParseAndCheckProject(options, userOpName) |> Async2.toAsync + member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async2 = + self.ParseAndCheckProject(options, userOpName) - member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = + member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async2 = self.ParseAndCheckProject(projectSnapshot.ToOptions(), userOpName) - |> Async2.toAsync member _.ParseFile (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) @@ -1677,7 +1661,6 @@ type internal BackgroundCompiler let options = projectSnapshot.ToOptions() self.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) - |> Async2.toAsync member _.ProjectChecked: IEvent = self.ProjectChecked diff --git a/src/Compiler/Service/BackgroundCompiler.fsi b/src/Compiler/Service/BackgroundCompiler.fsi index 6192b23e3f..35af38f78d 100644 --- a/src/Compiler/Service/BackgroundCompiler.fsi +++ b/src/Compiler/Service/BackgroundCompiler.fsi @@ -8,6 +8,8 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Diagnostics +open Internal.Utilities.Library + type SourceTextHash = int64 type CacheStamp = int64 @@ -32,7 +34,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. abstract CheckFileInProjectAllowingStaleCachedResults: @@ -42,7 +44,7 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 abstract ClearCache: options: FSharpProjectOptions seq * userOpName: string -> unit @@ -57,7 +59,7 @@ type internal IBackgroundCompiler = projectSnapshot: FSharpProjectSnapshot * symbol: FSharp.Compiler.Symbols.FSharpSymbol * userOpName: string -> - Async + Async2 abstract FindReferencesInFile: fileName: string * @@ -65,27 +67,27 @@ type internal IBackgroundCompiler = symbol: FSharp.Compiler.Symbols.FSharpSymbol * canInvalidateProject: bool * userOpName: string -> - Async + Async2 abstract GetAssemblyData: projectSnapshot: FSharpProjectSnapshot * outputFileName: string * userOpName: string -> - Async + Async2 abstract GetAssemblyData: - options: FSharpProjectOptions * outputFileName: string * userOpName: string -> Async + options: FSharpProjectOptions * outputFileName: string * userOpName: string -> Async2 /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) abstract GetBackgroundCheckResultsForFileInProject: fileName: string * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) abstract GetBackgroundParseResultsForFileInProject: - fileName: string * options: FSharpProjectOptions * userOpName: string -> Async + fileName: string * options: FSharpProjectOptions * userOpName: string -> Async2 abstract GetCachedCheckFileResult: builder: IncrementalBuilder * fileName: string * sourceText: ISourceText * options: FSharpProjectOptions -> - Async<(FSharpParseFileResults * FSharpCheckFileResults) option> + Async2<(FSharpParseFileResults * FSharpCheckFileResults) option> abstract GetProjectOptionsFromScript: fileName: string * @@ -100,7 +102,7 @@ type internal IBackgroundCompiler = assumeDotNetFramework: bool option * optionsStamp: int64 option * userOpName: string -> - Async + Async2 abstract GetProjectSnapshotFromScript: fileName: string * @@ -116,27 +118,27 @@ type internal IBackgroundCompiler = assumeDotNetFramework: bool option * optionsStamp: int64 option * userOpName: string -> - Async + Async2 abstract GetSemanticClassificationForFile: fileName: string * snapshot: FSharpProjectSnapshot * userOpName: string -> - Async + Async2 abstract GetSemanticClassificationForFile: fileName: string * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 abstract InvalidateConfiguration: options: FSharpProjectOptions * userOpName: string -> unit abstract InvalidateConfiguration: projectSnapshot: FSharpProjectSnapshot * userOpName: string -> unit - abstract NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async + abstract NotifyFileChanged: fileName: string * options: FSharpProjectOptions * userOpName: string -> Async2 - abstract NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async + abstract NotifyProjectCleaned: options: FSharpProjectOptions * userOpName: string -> Async2 abstract ParseAndCheckFileInProject: fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> - Async + Async2 /// Parses and checks the source file and returns untyped AST and check results. abstract ParseAndCheckFileInProject: @@ -145,17 +147,17 @@ type internal IBackgroundCompiler = sourceText: ISourceText * options: FSharpProjectOptions * userOpName: string -> - Async + Async2 abstract ParseAndCheckProject: - projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async + projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async2 /// Parse and typecheck the whole project. abstract ParseAndCheckProject: - options: FSharpProjectOptions * userOpName: string -> Async + options: FSharpProjectOptions * userOpName: string -> Async2 abstract ParseFile: - fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async + fileName: string * projectSnapshot: FSharpProjectSnapshot * userOpName: string -> Async2 abstract ParseFile: fileName: string * @@ -164,7 +166,7 @@ type internal IBackgroundCompiler = cache: bool * flatErrors: bool * userOpName: string -> - Async + Async2 /// Try to get recent approximate type check results for a file. abstract TryGetRecentCheckResultsForFile: diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 8aefb7f825..28f8d35e83 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -3,10 +3,8 @@ namespace FSharp.Compiler.CodeAnalysis open System -open System.Collections.Generic open System.IO open System.Threading -open System.Threading.Tasks open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader diff --git a/src/Compiler/Service/FSharpSource.fs b/src/Compiler/Service/FSharpSource.fs index fdcf70c28b..08586a596e 100644 --- a/src/Compiler/Service/FSharpSource.fs +++ b/src/Compiler/Service/FSharpSource.fs @@ -28,7 +28,7 @@ type FSharpSource internal () = abstract TimeStamp: DateTime - abstract GetTextContainer: unit -> Async + abstract GetTextContainer: unit -> Async2 type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, openStream: unit -> Stream) = inherit FSharpSource() @@ -38,7 +38,7 @@ type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, override _.TimeStamp = timeStamp override _.GetTextContainer() = - openStream () |> TextContainer.Stream |> async.Return + async2 { return openStream () |> TextContainer.Stream } type private FSharpSourceByteArray(filePath: string, timeStamp: DateTime, bytes: byte[]) = inherit FSharpSource() @@ -48,8 +48,7 @@ type private FSharpSourceByteArray(filePath: string, timeStamp: DateTime, bytes: override _.TimeStamp = timeStamp override _.GetTextContainer() = - TextContainer.Stream(new MemoryStream(bytes, 0, bytes.Length, false) :> Stream) - |> async.Return + async2 { return TextContainer.Stream(new MemoryStream(bytes, 0, bytes.Length, false) :> Stream) } type private FSharpSourceFromFile(filePath: string) = inherit FSharpSource() @@ -58,9 +57,9 @@ type private FSharpSourceFromFile(filePath: string) = override _.TimeStamp = FileSystem.GetLastWriteTimeShim(filePath) - override _.GetTextContainer() = TextContainer.OnDisk |> async.Return + override _.GetTextContainer() = async2 { return TextContainer.OnDisk } -type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = +type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText: unit -> Async) = inherit FSharpSource() override _.FilePath = filePath @@ -68,7 +67,7 @@ type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = override _.TimeStamp = getTimeStamp () override _.GetTextContainer() = - async { + async2 { let! sourceOpt = getSourceText () return diff --git a/src/Compiler/Service/FSharpSource.fsi b/src/Compiler/Service/FSharpSource.fsi index 6bdabbdedf..abe31eaf7c 100644 --- a/src/Compiler/Service/FSharpSource.fsi +++ b/src/Compiler/Service/FSharpSource.fsi @@ -5,6 +5,7 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.IO open FSharp.Compiler.Text +open Internal.Utilities.Library [] type internal TextContainer = @@ -26,7 +27,7 @@ type internal FSharpSource = abstract TimeStamp: DateTime /// Gets the internal text container. Text may be on-disk, in a stream, or a source text. - abstract GetTextContainer: unit -> Async + abstract GetTextContainer: unit -> Async2 /// Creates a FSharpSource from disk. Only used internally. static member internal CreateFromFile: filePath: string -> FSharpSource diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 8bad2ef61c..cc0d7720a5 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -272,7 +272,6 @@ type BoundModel private ( None, TcResultsSink.WithSink sink, prevTcInfo.tcState, input ) - |> Async2.toAsync fileChecked.Trigger fileName @@ -386,7 +385,7 @@ type BoundModel private ( GraphNode.FromResult tcInfo, tcInfoExtras | _ -> // start computing extras, so that typeCheckNode can be GC'd quickly - startComputingFullTypeCheck |> Async2.toAsync |> Async.Catch |> Async.Ignore |> Async.Start + startComputingFullTypeCheck |> Async2.Catch |> Async2.Ignore |> Async2.Start getTcInfo typeCheckNode, tcInfoExtras member val Diagnostics = diagnostics @@ -685,14 +684,14 @@ module IncrementalBuilderHelpers = #if !NO_TYPEPROVIDERS ,importsInvalidatedByTypeProvider: Event #endif - ) : Async = + ) : Async2 = - async { + async2 { let diagnosticsLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parameter) let! tcImports = - async { + async2 { try let! tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, dependencyProvider) #if !NO_TYPEPROVIDERS @@ -1676,4 +1675,3 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return builderOpt, diagnostics } - |> Async2.toAsync diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index 0f8ed5582d..40be34b204 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -3,7 +3,6 @@ namespace FSharp.Compiler.CodeAnalysis open System -open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.CheckBasics open FSharp.Compiler.CheckDeclarations @@ -21,7 +20,7 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree -open FSharp.Compiler.BuildGraph +open Internal.Utilities.Library open Internal.Utilities.Collections type internal FrameworkImportsCacheKey = @@ -297,7 +296,7 @@ type internal IncrementalBuilder = captureIdentifiersWhenParsing: bool * getSource: (string -> Async) option * useChangeNotifications: bool -> - Async + Async2 /// Generalized Incremental Builder. This is exposed only for unit testing purposes. module internal IncrementalBuild = diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 43f9110085..9dfe189372 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -301,13 +301,11 @@ module UnusedOpens = /// Get the open statements whose contents are not referred to anywhere in the symbol uses. /// Async to allow cancellation. let getUnusedOpens (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) : Async = - async { - use! _holder = Async2.UseTokenAsync() - + async2 { if checkFileResults.OpenDeclarations.Length = 0 then return [] else - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) let symbolUses = filterSymbolUses getSourceLineStr symbolUses let symbolUses = splitSymbolUses symbolUses @@ -318,6 +316,7 @@ module UnusedOpens = else return! filterOpenStatements symbolUses openStatements } + |> Async2.toAsync module SimplifyNames = type SimplifiableRange = { Range: range; RelativeName: string } @@ -326,9 +325,9 @@ module SimplifyNames = (plid |> List.sumBy String.length) + plid.Length let getSimplifiableNames (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) = - async { + async2 { let result = ResizeArray() - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) @@ -405,6 +404,7 @@ module SimplifyNames = return (result :> seq<_>) } + |> Async2.toAsync module UnusedDeclarations = let isPotentiallyUnusedDeclaration (symbol: FSharpSymbol) : bool = @@ -464,9 +464,10 @@ module UnusedDeclarations = |> Seq.map (fun (m, _) -> m) let getUnusedDeclarations (checkFileResults: FSharpCheckFileResults, isScriptFile: bool) = - async { - let! ct = Async.CancellationToken + async2 { + let ct = Async2.CancellationToken let allSymbolUsesInFile = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) let unusedRanges = getUnusedDeclarationRanges allSymbolUsesInFile isScriptFile return unusedRanges } + |> Async2.toAsync diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 8472c47af7..adc35a2a6c 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -217,17 +217,17 @@ module private TypeCheckingGraphProcessing = /// let processTypeCheckingGraph (graph: Graph) - (work: NodeToTypeCheck -> TcInfo -> Async>) + (work: NodeToTypeCheck -> TcInfo -> Async2>) (emptyState: TcInfo) - : Async<(int * PartialResult) list * TcInfo> = - async { + : Async2<(int * PartialResult) list * TcInfo> = + async2 { let workWrapper (getProcessedNode: NodeToTypeCheck -> ProcessedNode>) (node: NodeInfo) - : Async> = - async { + : Async2> = + async2 { let folder (state: TcInfo) (Finisher(finisher = finisher)) : TcInfo = finisher state |> snd let deps = node.Deps |> Array.except [| node.Item |] |> Array.map getProcessedNode @@ -422,7 +422,7 @@ type internal TransparentCompiler enablePartialTypeChecking, parallelReferenceResolution, captureIdentifiersWhenParsing, - getSource: (string -> Async) option, + getSource, useChangeNotifications, ?cacheSizes ) as self = @@ -579,7 +579,7 @@ type internal TransparentCompiler caches.ScriptClosure.Get( key, - async { + async2 { return ComputeScriptClosureInner fileName @@ -615,7 +615,7 @@ type internal TransparentCompiler caches.FrameworkImports.Get( key, - async { + async2 { use _ = Activity.start "ComputeFrameworkImports" [] let tcConfigP = TcConfigProvider.Constant tcConfig @@ -639,14 +639,14 @@ type internal TransparentCompiler importsInvalidatedByTypeProvider: Event ) = - async { + async2 { let diagnosticsLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parameter) let! tcImports = - async { + async2 { try let! tcImports = TcImports.BuildNonFrameworkTcImports( @@ -751,7 +751,7 @@ type internal TransparentCompiler then { new IProjectReference with member x.EvaluateRawContents() = - async { + async2 { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) return! @@ -784,7 +784,6 @@ type internal TransparentCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -799,7 +798,6 @@ type internal TransparentCompiler let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Async2.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -807,7 +805,7 @@ type internal TransparentCompiler ] let ComputeTcConfigBuilder (projectSnapshot: ProjectSnapshot) = - async { + async2 { let useSimpleResolutionSwitch = "--simpleresolution" let commandLineArgs = projectSnapshot.CommandLineOptions let defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir @@ -832,8 +830,8 @@ type internal TransparentCompiler match lastScriptFile, projectSnapshot.UseScriptResolutionRules with | Some fsxFile, true -> // assuming UseScriptResolutionRules and a single source file means we are doing this for a script - async { - let! source = fsxFile.GetSource() |> Async.AwaitTask + async2 { + let! source = fsxFile.GetSource() let! closure = ComputeScriptClosure @@ -851,7 +849,7 @@ type internal TransparentCompiler return (Some closure) } - | _ -> async { return None } + | _ -> async2 { return None } let sdkDirOverride = match loadClosureOpt with @@ -933,7 +931,7 @@ type internal TransparentCompiler caches.BootstrapInfoStatic.Get( cacheKey, - async { + async2 { use _ = Activity.start "ComputeBootstrapInfoStatic" @@ -1014,7 +1012,7 @@ type internal TransparentCompiler ) let computeBootstrapInfoInner (projectSnapshot: ProjectSnapshot) = - async { + async2 { let! tcConfigB, sourceFiles, loadClosureOpt = ComputeTcConfigBuilder projectSnapshot @@ -1090,7 +1088,7 @@ type internal TransparentCompiler caches.BootstrapInfo.Get( projectSnapshot.NoFileVersionsKey, - async { + async2 { use _ = Activity.start "ComputeBootstrapInfo" @@ -1103,7 +1101,7 @@ type internal TransparentCompiler use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! bootstrapInfoOpt = - async { + async2 { try return! computeBootstrapInfoInner projectSnapshot with exn -> @@ -1136,8 +1134,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 = - async { - let! source = file.GetSource() |> Async.AwaitTask + async2 { + let! source = file.GetSource() return FSharpFileSnapshotWithSource( @@ -1150,13 +1148,13 @@ type internal TransparentCompiler } let LoadSources (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshot) = - async { + async2 { let isExe = bootstrapInfo.TcConfig.target.IsExe let! sources = projectSnapshot.SourceFiles |> Seq.map (fun f -> LoadSource f isExe (f.FileName = bootstrapInfo.LastFileName)) - |> MultipleDiagnosticsLoggers.Parallel + |> MultipleDiagnosticsLoggers.Parallel2 return ProjectSnapshotWithSources(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, sources |> Array.toList) @@ -1180,7 +1178,7 @@ type internal TransparentCompiler caches.ParseFile.Get( key, - async { + async2 { use _ = Activity.start "ComputeParseFile" @@ -1224,7 +1222,7 @@ type internal TransparentCompiler |> Graph.make let computeDependencyGraph (tcConfig: TcConfig) parsedInputs (processGraph: Graph -> Graph) = - async { + async2 { let sourceFiles: FileInProject array = parsedInputs |> Seq.toArray @@ -1359,7 +1357,7 @@ type internal TransparentCompiler caches.TcIntermediate.Get( key, - async { + async2 { let file = projectSnapshot.SourceFiles[index] @@ -1453,7 +1451,7 @@ type internal TransparentCompiler let processGraphNode projectSnapshot bootstrapInfo dependencyFiles collectSinks (fileNode: NodeToTypeCheck) tcInfo = // TODO: should this be node? - async { + async2 { match fileNode with | NodeToTypeCheck.PhysicalFile index -> @@ -1536,11 +1534,11 @@ type internal TransparentCompiler } let parseSourceFiles (projectSnapshot: ProjectSnapshotWithSources) tcConfig = - async { + async2 { let! parsedInputs = projectSnapshot.SourceFiles |> Seq.map (ComputeParseFile projectSnapshot tcConfig) - |> MultipleDiagnosticsLoggers.Parallel + |> MultipleDiagnosticsLoggers.Parallel2 return ProjectSnapshotBase<_>(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, parsedInputs |> Array.toList) } @@ -1551,7 +1549,7 @@ type internal TransparentCompiler caches.TcLastFile.Get( projectSnapshot.FileKey fileName, - async { + async2 { let file = projectSnapshot.SourceFiles |> List.last use _ = @@ -1574,7 +1572,7 @@ type internal TransparentCompiler ) let getParseResult (projectSnapshot: ProjectSnapshot) creationDiags file (tcConfig: TcConfig) = - async { + async2 { let! parsedFile = ComputeParseFile projectSnapshot tcConfig file let parseDiagnostics = @@ -1607,7 +1605,7 @@ type internal TransparentCompiler let ComputeParseAndCheckFileInProject (fileName: string) (projectSnapshot: ProjectSnapshot) = caches.ParseAndCheckFileInProject.Get( projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, - async { + async2 { use! _holder = Async2.UseTokenAsync() use _ = @@ -1719,7 +1717,7 @@ type internal TransparentCompiler let ComputeParseAndCheckAllFilesInProject (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshotWithSources) = caches.ParseAndCheckAllFilesInProject.Get( projectSnapshot.FullKey, - async { + async2 { use _ = Activity.start "ComputeParseAndCheckAllFilesInProject" @@ -1769,7 +1767,7 @@ type internal TransparentCompiler let ComputeProjectExtras (bootstrapInfo: BootstrapInfo) (projectSnapshot: ProjectSnapshotWithSources) = caches.ProjectExtras.Get( projectSnapshot.SignatureKey, - async { + async2 { use _ = Activity.start "ComputeProjectExtras" @@ -1868,7 +1866,7 @@ type internal TransparentCompiler let ComputeAssemblyData (projectSnapshot: ProjectSnapshot) fileName = caches.AssemblyData.Get( projectSnapshot.SignatureKey, - async { + async2 { use _ = Activity.start "ComputeAssemblyData" @@ -1923,7 +1921,7 @@ type internal TransparentCompiler let ComputeParseAndCheckProject (projectSnapshot: ProjectSnapshot) = caches.ParseAndCheckProject.Get( projectSnapshot.FullKey, - async { + async2 { use! _holder = Async2.UseTokenAsync() match! ComputeBootstrapInfo projectSnapshot with @@ -1997,7 +1995,7 @@ type internal TransparentCompiler ) let tryGetSink (fileName: string) (projectSnapshot: ProjectSnapshot) = - async { + async2 { use! _holder = Async2.UseTokenAsync() match! ComputeBootstrapInfo projectSnapshot with @@ -2014,7 +2012,7 @@ type internal TransparentCompiler let ComputeSemanticClassification (fileName: string, projectSnapshot: ProjectSnapshot) = caches.SemanticClassification.Get( projectSnapshot.FileKey fileName, - async { + async2 { use _ = Activity.start "ComputeSemanticClassification" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] @@ -2044,7 +2042,7 @@ type internal TransparentCompiler let ComputeItemKeyStore (fileName: string, projectSnapshot: ProjectSnapshot) = caches.ItemKeyStore.Get( projectSnapshot.FileKey fileName, - async { + async2 { use _ = Activity.start "ComputeItemKeyStore" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] @@ -2079,7 +2077,7 @@ type internal TransparentCompiler ) member _.ParseFile(fileName, projectSnapshot: ProjectSnapshot, _userOpName) = - async { + async2 { //use _ = // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] @@ -2103,10 +2101,10 @@ type internal TransparentCompiler member _.ParseFileWithoutProject (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) - : Async = + : Async2 = let parseFileAsync = - async { - let! ct = Async.CancellationToken + async2 { + let ct = Async2.CancellationToken let diagnostics, parsedInput, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, false, flatErrors, false, ct) @@ -2165,7 +2163,7 @@ type internal TransparentCompiler member _.FindReferencesInFile(fileName: string, projectSnapshot: ProjectSnapshot, symbol: FSharpSymbol, userOpName: string) = ignore userOpName - async { + async2 { match! ComputeItemKeyStore(fileName, projectSnapshot) with | None -> return Seq.empty | Some itemKeyStore -> return itemKeyStore.FindAll symbol.Item @@ -2194,8 +2192,8 @@ type internal TransparentCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : Async = - async { + ) : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) ignore parseResults @@ -2213,8 +2211,8 @@ type internal TransparentCompiler sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string - ) : Async = - async { + ) : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) ignore parseResults @@ -2258,8 +2256,8 @@ type internal TransparentCompiler member this.FindReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) - : Async> = - async { + : Async2> = + async2 { ignore canInvalidateProject let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) @@ -2273,8 +2271,8 @@ type internal TransparentCompiler member _.FrameworkImportsCache: FrameworkImportsCache = backgroundCompiler.FrameworkImportsCache - member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : Async = - async { + member this.GetAssemblyData(options: FSharpProjectOptions, fileName, userOpName: string) : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! this.GetAssemblyData(snapshot.ProjectSnapshot, fileName, userOpName) @@ -2282,13 +2280,13 @@ type internal TransparentCompiler member this.GetAssemblyData (projectSnapshot: FSharpProjectSnapshot, fileName, userOpName: string) - : Async = + : Async2 = this.GetAssemblyData(projectSnapshot.ProjectSnapshot, fileName, userOpName) member this.GetBackgroundCheckResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = - async { + : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) match! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) with @@ -2298,8 +2296,8 @@ type internal TransparentCompiler member this.GetBackgroundParseResultsForFileInProject (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = - async { + : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) return! this.ParseFile(fileName, snapshot.ProjectSnapshot, userOpName) @@ -2307,8 +2305,8 @@ type internal TransparentCompiler member this.GetCachedCheckFileResult (builder: IncrementalBuilder, fileName: string, sourceText: ISourceText, options: FSharpProjectOptions) - : Async<(FSharpParseFileResults * FSharpCheckFileResults) option> = - async { + : Async2<(FSharpParseFileResults * FSharpCheckFileResults) option> = + async2 { ignore builder let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, 1, sourceText, documentSource) @@ -2332,8 +2330,8 @@ type internal TransparentCompiler assumeDotNetFramework: bool option, optionsStamp: int64 option, userOpName: string - ) : Async = - async { + ) : Async2 = + async2 { let bc = this :> IBackgroundCompiler let! snapshot, diagnostics = @@ -2372,13 +2370,13 @@ type internal TransparentCompiler assumeDotNetFramework: bool option, optionsStamp: int64 option, userOpName: string - ) : Async = + ) : Async2 = use _ = Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] - async { + async2 { // Use the same default as the background compiler. let useFsiAuxLib = defaultArg useFsiAuxLib true let useSdkRefs = defaultArg useSdkRefs true @@ -2439,7 +2437,7 @@ type internal TransparentCompiler optionsStamp // Populate the cache. - let! _ = caches.ScriptClosure.Get(loadClosureKey, async { return loadClosure }) + let! _ = caches.ScriptClosure.Get(loadClosureKey, async2 { return loadClosure }) let sourceFiles = loadClosure.SourceFiles @@ -2486,15 +2484,15 @@ type internal TransparentCompiler } member this.GetSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, userOpName: string) = - async { + async2 { ignore userOpName return! ComputeSemanticClassification(fileName, snapshot.ProjectSnapshot) } member this.GetSemanticClassificationForFile (fileName: string, options: FSharpProjectOptions, userOpName: string) - : Async = - async { + : Async2 = + async2 { ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) @@ -2508,16 +2506,16 @@ type internal TransparentCompiler member this.InvalidateConfiguration(projectSnapshot: FSharpProjectSnapshot, _userOpName: string) : unit = this.Caches.Clear(Set.singleton projectSnapshot.Identifier) - member this.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = + member this.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async2 = backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) - member this.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async = + member this.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName: string) : Async2 = backgroundCompiler.NotifyProjectCleaned(options, userOpName) member this.ParseAndCheckFileInProject (fileName: string, fileVersion: int, sourceText: ISourceText, options: FSharpProjectOptions, userOpName: string) - : Async = - async { + : Async2 = + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, fileName, fileVersion, sourceText, documentSource) return! this.ParseAndCheckFileInProject(fileName, snapshot.ProjectSnapshot, userOpName) @@ -2526,8 +2524,8 @@ 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) : Async = - async { + member this.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async2 = + async2 { ignore userOpName let! snapshot = FSharpProjectSnapshot.FromOptions(options, documentSource) @@ -2535,8 +2533,8 @@ type internal TransparentCompiler return! ComputeParseAndCheckProject snapshot.ProjectSnapshot } - member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async = - async { + member this.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, userOpName: string) : Async2 = + async2 { ignore userOpName return! ComputeParseAndCheckProject projectSnapshot.ProjectSnapshot } @@ -2546,7 +2544,7 @@ type internal TransparentCompiler member this.ParseFile (fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) - : Async = + : Async2 = this.ParseFileWithoutProject(fileName, sourceText, options, cache, flatErrors, userOpName) member this.TryGetRecentCheckResultsForFile diff --git a/src/Compiler/Service/TransparentCompiler.fsi b/src/Compiler/Service/TransparentCompiler.fsi index 8703df0fe7..63c167a249 100644 --- a/src/Compiler/Service/TransparentCompiler.fsi +++ b/src/Compiler/Service/TransparentCompiler.fsi @@ -22,6 +22,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.EditorServices open FSharp.Compiler.CodeAnalysis.ProjectSnapshot +open Internal.Utilities.Library /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] @@ -204,19 +205,19 @@ type internal TransparentCompiler = member FindReferencesInFile: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * symbol: FSharpSymbol * userOpName: string -> - Async + Async2 member GetAssemblyData: projectSnapshot: ProjectSnapshot.ProjectSnapshot * fileName: string * _userOpName: string -> - Async + Async2 member ParseAndCheckFileInProject: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * userOpName: string -> - Async + Async2 member ParseFile: fileName: string * projectSnapshot: ProjectSnapshot.ProjectSnapshot * _userOpName: 'a -> - Async + Async2 member SetCacheSize: cacheSize: CacheSizes -> unit member SetCacheSizeFactor: sizeFactor: int -> unit diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 7a013e1fd7..68eaf5ff0b 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -273,11 +273,11 @@ type FSharpChecker let hash = sourceText.GetHashCode() |> int64 - async { + async2 { match braceMatchCache.TryGet(AnyCallerThread, (fileName, hash, options)) with | Some res -> return res | None -> - let! ct = Async.CancellationToken + let ct = Async2.CancellationToken let res = ParseAndCheckFile.matchBraces (sourceText, fileName, options, userOpName, suggestNamesForErrors, ct) @@ -285,6 +285,7 @@ type FSharpChecker braceMatchCache.Set(AnyCallerThread, (fileName, hash, options), res) return res } + |> Async2.toAsync member ic.MatchBraces(fileName, source: string, options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" @@ -299,12 +300,12 @@ type FSharpChecker member _.ParseFile(fileName, sourceText, options, ?cache, ?userOpName: string) = let cache = defaultArg cache true let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseFile(fileName, sourceText, options, cache, false, userOpName) + backgroundCompiler.ParseFile(fileName, sourceText, options, cache, false, userOpName) |> Async2.toAsync member _.ParseFile(fileName, projectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) + backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) |> Async2.toAsync member ic.ParseFileInProject(fileName, source: string, options, ?cache: bool, ?userOpName: string) = let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) @@ -313,12 +314,12 @@ type FSharpChecker member _.GetBackgroundParseResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync member _.GetBackgroundCheckResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) + backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, ?sourceText, ?userOpName: string) = @@ -379,12 +380,12 @@ type FSharpChecker /// This function is called when a project has been cleaned, and thus type providers should be refreshed. member _.NotifyProjectCleaned(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.NotifyProjectCleaned(options, userOpName) + backgroundCompiler.NotifyProjectCleaned(options, userOpName) |> Async2.toAsync member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) + backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -400,7 +401,7 @@ type FSharpChecker SourceText.ofString source, options, userOpName - ) + ) |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -415,7 +416,7 @@ type FSharpChecker ) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) + backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -424,22 +425,22 @@ type FSharpChecker = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync member _.ParseAndCheckFileInProject(fileName: string, projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) + backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) |> Async2.toAsync member _.ParseAndCheckProject(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckProject(options, userOpName) + backgroundCompiler.ParseAndCheckProject(options, userOpName) |> Async2.toAsync member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) + backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) |> Async2.toAsync member _.FindBackgroundReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, ?canInvalidateProject: bool, ?fastCheck: bool, ?userOpName: string) @@ -447,7 +448,7 @@ type FSharpChecker let canInvalidateProject = defaultArg canInvalidateProject true let userOpName = defaultArg userOpName "Unknown" - async { + async2 { if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) else @@ -461,11 +462,12 @@ type FSharpChecker else return Seq.empty } + |> Async2.toAsync member _.FindBackgroundReferencesInFile(fileName: string, projectSnapshot: FSharpProjectSnapshot, symbol: FSharpSymbol, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - async { + async2 { let! parseResults = backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) if @@ -476,16 +478,17 @@ type FSharpChecker else return Seq.empty } + |> Async2.toAsync - member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) = + member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) : Async = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) + backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) |> Async2.toAsync member _.GetBackgroundSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) + backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) |> Async2.toAsync /// For a given script file, get the ProjectOptions implied by the #load closure member _.GetProjectOptionsFromScript @@ -518,7 +521,7 @@ type FSharpChecker assumeDotNetFramework, optionsStamp, userOpName - ) + ) |> Async2.toAsync /// For a given script file, get the ProjectSnapshot implied by the #load closure member _.GetProjectSnapshotFromScript @@ -554,7 +557,7 @@ type FSharpChecker assumeDotNetFramework, optionsStamp, userOpName - ) + ) |> Async2.toAsync member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 9b746371c1..291a2c4d08 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -7,7 +7,7 @@ open System.Runtime.CompilerServices #nowarn 3513 -type internal Async2<'t> = +type Async2<'t> = abstract Start: unit -> Task<'t> abstract GetAwaiter: unit -> TaskAwaiter<'t> @@ -466,3 +466,63 @@ module internal Async2 = let fromValue (value: 't) : Async2<'t> = let task = Task.FromResult value Async2Impl(fun () -> task) + +type internal Async2 with + static member Ignore (computation: Async2<_>) : Async2 = + async2 { + let! _ = computation + return () + } + + static member Start (computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = + let ct = defaultArg cancellationToken CancellationToken.None + Async2.startAsTask ct computation |> ignore + + static member StartAsTask (computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = + let ct = defaultArg cancellationToken CancellationToken.None + Async2.startAsTask ct computation + + static member RunImmediate (computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = + let ct = defaultArg cancellationToken CancellationToken.None + Async2.run ct computation + + static member Parallel (computations: Async2<_> seq) = + async2 { + use lcts = CancellationTokenSource.CreateLinkedTokenSource Async2.CancellationToken + let tasks = + seq { + for c in computations do + c |> Async2.startAsTask lcts.Token + } + + return! Task.WhenAll tasks + } + + static member Sequential (computations: Async2<_> seq) = + async2 { + let results = ResizeArray() + for c in computations do + let! r = c + results.Add r + return results.ToArray() + } + + static member Catch (computation: Async2<'T>) : Async2> = + async2 { + try + let! res = computation + return Choice1Of2 res + with exn -> + return Choice2Of2 exn + } + + static member TryCancelled(computation: Async2<'T>, compensation) = + async2 { + let ct = Async2.CancellationToken + let task = computation |> Async2.startAsTask ct + try + return! task + finally + if task.IsCanceled then + compensation () + } diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 77e8f4b213..8519bb4296 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -3,6 +3,7 @@ module CompilerService.AsyncMemoize open System open System.Threading open Internal.Utilities.Collections +open Internal.Utilities.Library open System.Threading.Tasks open System.Diagnostics @@ -68,7 +69,7 @@ let awaitHandle h = h |> Async.AwaitWaitHandle |> Async.Ignore [] let ``Basics``() = - let computation key = async { + let computation key = async2 { do! Async.Sleep 1 return key * 2 } @@ -85,8 +86,8 @@ let ``Basics``() = memoize.Get(wrapKey 3, computation 3) memoize.Get(wrapKey 2, computation 2) } - |> Async.Parallel - |> Async.RunSynchronously + |> Async2.Parallel + |> Async2.RunImmediate let expected = [| 10; 10; 4; 10; 6; 4|] @@ -105,7 +106,7 @@ let ``We can disconnect a request from a running job`` () = let cts = new CancellationTokenSource() let canFinish = new ManualResetEvent(false) - let computation = async { + let computation = async2 { do! awaitHandle canFinish } @@ -114,7 +115,7 @@ let ``We can disconnect a request from a running job`` () = let key = 1 - let task1 = Async.StartAsTask( memoize.Get(wrapKey 1, computation), cancellationToken = cts.Token) + let task1 = Async2.StartAsTask( memoize.Get(wrapKey 1, computation), cancellationToken = cts.Token) waitUntil events (received Started) cts.Cancel() @@ -133,7 +134,7 @@ let ``We can cancel a job`` () = let cts = new CancellationTokenSource() - let computation = async { + let computation = async2 { while true do do! Async.Sleep 1000 } @@ -143,7 +144,7 @@ let ``We can cancel a job`` () = let key = 1 - let task1 = Async.StartAsTask( memoize.Get(wrapKey 1, computation), cancellationToken = cts.Token) + let task1 = Async2.StartAsTask( memoize.Get(wrapKey 1, computation), cancellationToken = cts.Token) waitUntil events (received Started) @@ -160,7 +161,7 @@ let ``We can cancel a job`` () = let ``Job is restarted if first requestor cancels`` () = let jobCanComplete = new ManualResetEvent(false) - let computation key = async { + let computation key = async2 { do! awaitHandle jobCanComplete return key * 2 } @@ -172,7 +173,7 @@ let ``Job is restarted if first requestor cancels`` () = let key = 1 - let task1 = Async.StartAsTask( memoize.Get(wrapKey key, computation key), cancellationToken = cts1.Token) + let task1 = Async2.StartAsTask( memoize.Get(wrapKey key, computation key), cancellationToken = cts1.Token) waitUntil events (received Started) cts1.Cancel() @@ -181,7 +182,7 @@ let ``Job is restarted if first requestor cancels`` () = waitUntil events (received Canceled) - let task2 = Async.StartAsTask( memoize.Get(wrapKey key, computation key)) + let task2 = Async2.StartAsTask( memoize.Get(wrapKey key, computation key)) waitUntil events (countOf Started >> (=) 2) @@ -202,7 +203,7 @@ let ``Job is actually cancelled and restarted`` () = let jobCanComplete = new ManualResetEvent(false) let mutable finishedCount = 0 - let computation = async { + let computation = async2 { do! awaitHandle jobCanComplete Interlocked.Increment &finishedCount |> ignore return 42 @@ -215,14 +216,14 @@ let ``Job is actually cancelled and restarted`` () = for i in 1 .. 10 do use cts = new CancellationTokenSource() - let task = Async.StartAsTask( memoize.Get(key, computation), cancellationToken = cts.Token) + let task = Async2.StartAsTask( memoize.Get(key, computation), cancellationToken = cts.Token) waitUntil events (received Started) cts.Cancel() assertTaskCanceled task waitUntil events (received Canceled) Assert.Equal(1, memoize.Count) - let _task2 = Async.StartAsTask( memoize.Get(key, computation)) + let _task2 = Async2.StartAsTask( memoize.Get(key, computation)) waitUntil events (received Started) @@ -237,7 +238,7 @@ let ``Job keeps running if only one requestor cancels`` () = let jobCanComplete = new ManualResetEvent(false) - let computation key = async { + let computation key = async2 { do! awaitHandle jobCanComplete return key * 2 } @@ -249,11 +250,11 @@ let ``Job keeps running if only one requestor cancels`` () = let key = 1 - let task1 = Async.StartAsTask( memoize.Get(wrapKey key, computation key)) + let task1 = Async2.StartAsTask( memoize.Get(wrapKey key, computation key)) waitUntil events (received Started) - let task2 = Async.StartAsTask( memoize.Get(wrapKey key, computation key) |> Async.Ignore, cancellationToken = cts.Token) + let task2 = Async2.StartAsTask( memoize.Get(wrapKey key, computation key) |> Async2.Ignore, cancellationToken = cts.Token) waitUntil events (countOf Requested >> (=) 2) @@ -294,7 +295,7 @@ let ``Stress test`` () = let testTimeoutMs = threads * iterations * maxDuration * 2 let intenseComputation durationMs result = - async { + async2 { if rng.NextDouble() < exceptionProbability then raise (ExpectedException()) let s = Stopwatch.StartNew() @@ -305,7 +306,7 @@ let ``Stress test`` () = } let rec sleepyComputation durationMs result = - async { + async2 { if rng.NextDouble() < (exceptionProbability / (float durationMs / float stepMs)) then raise (ExpectedException()) if durationMs > 0 then @@ -316,7 +317,7 @@ let ``Stress test`` () = } let rec mixedComputation durationMs result = - async { + async2 { if durationMs > 0 then if rng.NextDouble() < 0.5 then let! _ = intenseComputation (min stepMs durationMs) () @@ -358,7 +359,7 @@ let ``Stress test`` () = let result = key * 2 let job = cache.Get(wrapKey key, computation durationMs result) let cts = new CancellationTokenSource() - let runningJob = Async.StartAsTask(job, cancellationToken = cts.Token) + let runningJob = Async2.StartAsTask(job, cancellationToken = cts.Token) cts.CancelAfter timeoutMs Interlocked.Increment &started |> ignore try @@ -394,7 +395,7 @@ let ``Stress test`` () = Assert.True ((float completed) > ((float started) * 0.1), "Less than 10 % completed jobs") -[] +[] let ``Cancel running jobs with the same key`` () = let cache = AsyncMemoize(cancelUnawaitedJobs = false, cancelDuplicateRunningJobs = true) @@ -402,7 +403,7 @@ let ``Cancel running jobs with the same key`` () = let jobCanContinue = new ManualResetEvent(false) - let work = async { + let work = async2 { do! awaitHandle jobCanContinue } @@ -415,7 +416,7 @@ let ``Cancel running jobs with the same key`` () = let cts = new CancellationTokenSource() let jobsToCancel = - [ for i in 1 .. 10 -> Async.StartAsTask(cache.Get(key i , work), cancellationToken = cts.Token) ] + [ for i in 1 .. 10 -> Async2.StartAsTask(cache.Get(key i , work), cancellationToken = cts.Token) ] waitUntil events (countOf Started >> (=) 10) @@ -426,7 +427,7 @@ let ``Cancel running jobs with the same key`` () = for job in jobsToCancel do assertTaskCanceled job // Start another request. - let job = cache.Get(key 11, work) |> Async.StartAsTask + let job = cache.Get(key 11, work) |> Async2.StartAsTask // up til now the jobs should have been running unobserved let current = eventsWhen events (received Requested) @@ -461,14 +462,14 @@ let ``Preserve thread static diagnostics`` () = let job1Cache = AsyncMemoize() let job2Cache = AsyncMemoize() - let job1 (input: string) = async { + let job1 (input: string) = async2 { let! _ = Async.Sleep (rng.Next(1, 30)) let ex = DummyException("job1 error") DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex) return Ok input } - let job2 (input: int) = async { + let job2 (input: int) = async2 { DiagnosticsThreadStatics.DiagnosticsLogger.Warning(DummyException("job2 error 1")) @@ -535,7 +536,7 @@ let ``Preserve thread static diagnostics already completed job`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job (input: string) = async { + let job (input: string) = async2 { let ex = DummyException($"job {input} error") DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex) return Ok input @@ -567,7 +568,7 @@ let ``We get diagnostics from the job that failed`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job = async { + let job = async2 { let ex = DummyException($"job error") // no recovery @@ -580,7 +581,7 @@ let ``We get diagnostics from the job that failed`` () = SetThreadDiagnosticsLoggerNoUnwind logger - do! cache.Get(key, job ) |> Async.Catch |> Async.Ignore + do! cache.Get(key, job ) |> Async2.Catch |> Async2.Ignore let messages = logger.Diagnostics |> List.map fst |> List.map _.Exception.Message diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 960057baf9..3dbe641d62 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -312,12 +312,6 @@ - - - - - - @@ -352,6 +346,18 @@ + + + + + CompilerService\Async2.fs + + + CompilerService\AsyncMemoImpl.fs + + + + diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 320c522b41..5aec87f4b4 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12383,6 +12383,8 @@ FSharp.Compiler.Xml.XmlDoc: System.String[] GetElaboratedXmlLines() FSharp.Compiler.Xml.XmlDoc: System.String[] UnprocessedLines FSharp.Compiler.Xml.XmlDoc: System.String[] get_UnprocessedLines() FSharp.Compiler.Xml.XmlDoc: Void .ctor(System.String[], FSharp.Compiler.Text.Range) +Internal.Utilities.Library.Async2`1[t]: System.Runtime.CompilerServices.TaskAwaiter`1[t] GetAwaiter() +Internal.Utilities.Library.Async2`1[t]: System.Threading.Tasks.Task`1[t] Start() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] CreateDictionary(T[]) Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] GetDictionary() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: T[] GetArray() diff --git a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs index 518bf88bc7..2f6d923770 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs @@ -11,7 +11,6 @@ open FSharp.Compiler open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CodeAnalysis.ProjectSnapshot open FSharp.Compiler.Symbols -open FSharp.Compiler.BuildGraph open CancellableTasks @@ -20,7 +19,6 @@ open System.IO open Internal.Utilities.Collections open Newtonsoft.Json open Newtonsoft.Json.Linq -open System.Text.Json.Nodes #nowarn "57" // Experimental stuff @@ -377,7 +375,7 @@ module private CheckerExtensions = member _.GetLabel() = project.FilePath } - snapshotCache.Get( + snapshotCache.GetAsync( key, async { let! ct = Async.CancellationToken From 84cb4eed2e57c4984f3b2ef0a19f37cbfa148436 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 8 Sep 2025 19:59:34 +0200 Subject: [PATCH 25/48] graph processing --- .../Driver/GraphChecking/GraphProcessing.fs | 147 ++---------------- src/Compiler/Utilities/Async2.fs | 13 +- 2 files changed, 23 insertions(+), 137 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index c4301b4ef4..57f51dbbc1 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -39,137 +39,6 @@ type ProcessedNode<'Item, 'Result> = type GraphProcessingException(msg, ex: System.Exception) = inherit exn(msg, ex) -let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> - (graph: Graph<'Item>) - (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result) - (parentCt: CancellationToken) - : ('Item * 'Result)[] = - let transitiveDeps = graph |> Graph.transitive - let dependents = graph |> Graph.reverse - // Cancellation source used to signal either an exception in one of the items or end of processing. - use localCts = new CancellationTokenSource() - use cts = CancellationTokenSource.CreateLinkedTokenSource(parentCt, localCts.Token) - - let makeNode (item: 'Item) : GraphNode<'Item, 'Result> = - let info = - let exists = graph.ContainsKey item - - if - not exists - || not (transitiveDeps.ContainsKey item) - || not (dependents.ContainsKey item) - then - printfn $"Unexpected inconsistent state of the graph for item '{item}'" - - { - Item = item - Deps = graph[item] - TransitiveDeps = transitiveDeps[item] - Dependents = dependents[item] - } - - { - Info = info - Result = None - ProcessedDepsCount = IncrementableInt(0) - } - - let nodes = graph.Keys |> Seq.map (fun item -> item, makeNode item) |> readOnlyDict - - let lookupMany items = - items |> Array.map (fun item -> nodes[item]) - - let leaves = - nodes.Values |> Seq.filter (fun n -> n.Info.Deps.Length = 0) |> Seq.toArray - - let getItemPublicNode item = - let node = nodes[item] - - { - ProcessedNode.Info = node.Info - ProcessedNode.Result = - node.Result - |> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available") - } - - let processedCount = IncrementableInt(0) - - /// Create a setter and getter for an exception raised in one of the work items. - /// Only the first exception encountered is stored - this can cause non-deterministic errors if more than one item fails. - let raiseExn, getExn = - let mutable exn: ('Item * System.Exception) option = None - let lockObj = obj () - // Only set the exception if it hasn't been set already - let setExn newExn = - lock lockObj (fun () -> - match exn with - | Some _ -> () - | None -> exn <- newExn - - localCts.Cancel()) - - let getExn () = exn - setExn, getExn - - let incrementProcessedNodesCount () = - if processedCount.Increment() = nodes.Count then - localCts.Cancel() - - let rec queueNode node = - Async.Start( - async { - let! res = async { processNode node } |> Async.Catch - - match res with - | Choice1Of2() -> () - | Choice2Of2 ex -> raiseExn (Some(node.Info.Item, ex)) - }, - cts.Token - ) - - and processNode (node: GraphNode<'Item, 'Result>) : unit = - - let info = node.Info - - let singleRes = work getItemPublicNode info - node.Result <- Some singleRes - - let unblockedDependents = - node.Info.Dependents - |> lookupMany - // For every dependent, increment its number of processed dependencies, - // and filter dependents which now have all dependencies processed (but didn't before). - |> Array.filter (fun dependent -> - let pdc = dependent.ProcessedDepsCount.Increment() - // Note: We cannot read 'dependent.ProcessedDepsCount' again to avoid returning the same item multiple times. - pdc = dependent.Info.Deps.Length) - - unblockedDependents |> Array.iter queueNode - incrementProcessedNodesCount () - - leaves |> Array.iter queueNode - - // Wait for end of processing, an exception, or an external cancellation request. - cts.Token.WaitHandle.WaitOne() |> ignore - // If we stopped early due to external cancellation, throw. - parentCt.ThrowIfCancellationRequested() - - // If we stopped early due to an exception, reraise it. - match getExn () with - | None -> () - | Some(item, ex) -> raise (GraphProcessingException($"Encountered exception when processing item '{item}'", ex)) - - // All calculations succeeded - extract the results and sort in input order. - nodes.Values - |> Seq.map (fun node -> - let result = - node.Result - |> Option.defaultWith (fun () -> failwith $"Unexpected lack of result for item '{node.Info.Item}'") - - node.Info.Item, result) - |> Seq.sortBy fst - |> Seq.toArray - let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> (graph: Graph<'Item>) (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async2<'Result>) @@ -224,14 +93,12 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> async2 { try do! processNode node - with - | ex -> - return raise (GraphProcessingException($"[*] Encountered exception when processing item '{node.Info.Item}': {ex.Message}", ex)) + with ex -> + return raise (GraphProcessingException($"Encountered exception when processing item '{node.Info.Item}'", ex)) } - and processNode (node: GraphNode<'Item, 'Result>) : Async2 = + and processNode (node: GraphNode<'Item, 'Result>) = async2 { - let info = node.Info let! singleRes = work getItemPublicNode info @@ -265,3 +132,11 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> |> Seq.sortBy fst |> Seq.toArray } + +let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> + (graph: Graph<'Item>) + (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result) + (parentCt: CancellationToken) + : ('Item * 'Result)[] = + let work node info = async2 { return work node info } + Async2.RunImmediate(processGraphAsync graph (fun lookup info -> async2 { return! work lookup info }), parentCt) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 291a2c4d08..676a71ea5c 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -456,6 +456,9 @@ module internal Async2 = let startAsTask ct code = startWithContext { Token = ct } code + let queueTask ct code = + Task.Run<'t>(fun () -> startWithContext { Token = ct } code) + let toAsync (code: Async2<'t>) = async { let! ct = Async.CancellationToken @@ -492,7 +495,15 @@ type internal Async2 with let tasks = seq { for c in computations do - c |> Async2.startAsTask lcts.Token + async2 { + try + return! c + with + exn -> + lcts.Cancel() + return raise exn + } + |> Async2.queueTask lcts.Token } return! Task.WhenAll tasks From ad6311ee11b1d5f530fd4cc69689ff321a285302 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 9 Sep 2025 09:32:34 +0200 Subject: [PATCH 26/48] fix cancellation filtering --- .../Driver/GraphChecking/GraphProcessing.fs | 4 +- src/Compiler/Facilities/AsyncMemoize.fs | 9 +--- src/Compiler/Service/BackgroundCompiler.fs | 3 +- src/Compiler/Service/service.fs | 47 +++++++++++++------ src/Compiler/Utilities/Async2.fs | 27 ++++++----- 5 files changed, 53 insertions(+), 37 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 57f51dbbc1..ccdf5c6173 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -138,5 +138,5 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result) (parentCt: CancellationToken) : ('Item * 'Result)[] = - let work node info = async2 { return work node info } - Async2.RunImmediate(processGraphAsync graph (fun lookup info -> async2 { return! work lookup info }), parentCt) + let work node info = async2 { return work node info } + Async2.RunImmediate(processGraphAsync graph (fun lookup info -> async2 { return! work lookup info }), parentCt) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 9a35e9f87d..38b308f5a4 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -237,11 +237,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue log Finished key Interlocked.Add(&duration, sw.ElapsedMilliseconds) |> ignore return Result.Ok result, logger - with - | :? OperationCanceledException -> - log Canceled key - return Unchecked.defaultof<_> - | exn -> + with exn -> log Failed key return Result.Error exn, logger }, @@ -285,8 +281,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue } member this.GetAsync(key, computation: Async<_>) = - this.Get(key, async2 {return! computation}) - |> Async2.toAsync + this.Get(key, async2 { return! computation }) |> Async2.toAsync member _.TryGet(key: 'TKey, predicate: 'TVersion -> bool) : 'TValue option = lock cache diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index e2b5fc7cda..f2e80cfd0e 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -1642,8 +1642,7 @@ type internal BackgroundCompiler let! sourceText = fileSnapshot.GetSource() let options = projectSnapshot.ToOptions() - return! - self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) + return! self.ParseAndCheckFileInProject(fileName, 0, sourceText, options, userOpName) } member _.ParseAndCheckProject(options: FSharpProjectOptions, userOpName: string) : Async2 = diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 68eaf5ff0b..9411828da6 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -300,12 +300,15 @@ type FSharpChecker member _.ParseFile(fileName, sourceText, options, ?cache, ?userOpName: string) = let cache = defaultArg cache true let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseFile(fileName, sourceText, options, cache, false, userOpName) |> Async2.toAsync + + backgroundCompiler.ParseFile(fileName, sourceText, options, cache, false, userOpName) + |> Async2.toAsync member _.ParseFile(fileName, projectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) |> Async2.toAsync + backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) + |> Async2.toAsync member ic.ParseFileInProject(fileName, source: string, options, ?cache: bool, ?userOpName: string) = let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) @@ -314,12 +317,14 @@ type FSharpChecker member _.GetBackgroundParseResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync + backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + |> Async2.toAsync member _.GetBackgroundCheckResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) |> Async2.toAsync + backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) + |> Async2.toAsync /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, ?sourceText, ?userOpName: string) = @@ -385,7 +390,8 @@ type FSharpChecker member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) |> Async2.toAsync + backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) + |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -401,7 +407,8 @@ type FSharpChecker SourceText.ofString source, options, userOpName - ) |> Async2.toAsync + ) + |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -416,7 +423,8 @@ type FSharpChecker ) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync + backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) + |> Async2.toAsync /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -425,12 +433,14 @@ type FSharpChecker = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) |> Async2.toAsync + backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + |> Async2.toAsync member _.ParseAndCheckFileInProject(fileName: string, projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) |> Async2.toAsync + backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) + |> Async2.toAsync member _.ParseAndCheckProject(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" @@ -440,7 +450,8 @@ type FSharpChecker member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) |> Async2.toAsync + backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) + |> Async2.toAsync member _.FindBackgroundReferencesInFile (fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, ?canInvalidateProject: bool, ?fastCheck: bool, ?userOpName: string) @@ -480,15 +491,19 @@ type FSharpChecker } |> Async2.toAsync - member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) : Async = + member _.GetBackgroundSemanticClassificationForFile + (fileName: string, options: FSharpProjectOptions, ?userOpName) + : Async = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) |> Async2.toAsync + backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) + |> Async2.toAsync member _.GetBackgroundSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) |> Async2.toAsync + backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) + |> Async2.toAsync /// For a given script file, get the ProjectOptions implied by the #load closure member _.GetProjectOptionsFromScript @@ -521,7 +536,8 @@ type FSharpChecker assumeDotNetFramework, optionsStamp, userOpName - ) |> Async2.toAsync + ) + |> Async2.toAsync /// For a given script file, get the ProjectSnapshot implied by the #load closure member _.GetProjectSnapshotFromScript @@ -557,7 +573,8 @@ type FSharpChecker assumeDotNetFramework, optionsStamp, userOpName - ) |> Async2.toAsync + ) + |> Async2.toAsync member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 676a71ea5c..7ca4d2da4b 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -174,8 +174,10 @@ module internal Async2Implementation = module Async2Code = let inline filterCancellation ([] catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> + let ct = currentContext.Value.Token + match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = currentContext.Value.Token -> raise exn + | :? OperationCanceledException as oce when ct.IsCancellationRequested || oce.CancellationToken = ct -> raise exn | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: Async2Code<_, _>) = @@ -471,35 +473,35 @@ module internal Async2 = Async2Impl(fun () -> task) type internal Async2 with - static member Ignore (computation: Async2<_>) : Async2 = + static member Ignore(computation: Async2<_>) : Async2 = async2 { let! _ = computation return () } - static member Start (computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = + static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None Async2.startAsTask ct computation |> ignore - static member StartAsTask (computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = + static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None Async2.startAsTask ct computation - static member RunImmediate (computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = + static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None Async2.run ct computation - static member Parallel (computations: Async2<_> seq) = + static member Parallel(computations: Async2<_> seq) = async2 { use lcts = CancellationTokenSource.CreateLinkedTokenSource Async2.CancellationToken + let tasks = seq { for c in computations do async2 { try return! c - with - exn -> + with exn -> lcts.Cancel() return raise exn } @@ -509,16 +511,18 @@ type internal Async2 with return! Task.WhenAll tasks } - static member Sequential (computations: Async2<_> seq) = + static member Sequential(computations: Async2<_> seq) = async2 { let results = ResizeArray() + for c in computations do let! r = c results.Add r + return results.ToArray() } - static member Catch (computation: Async2<'T>) : Async2> = + static member Catch(computation: Async2<'T>) : Async2> = async2 { try let! res = computation @@ -531,7 +535,8 @@ type internal Async2 with async2 { let ct = Async2.CancellationToken let task = computation |> Async2.startAsTask ct - try + + try return! task finally if task.IsCanceled then From 20e9e7ed3004ad0bd825b0a8c4d35b687287d237 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 11 Sep 2025 17:11:52 +0200 Subject: [PATCH 27/48] align with async --- src/Compiler/Utilities/Async2.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 7ca4d2da4b..1c7ebe32bf 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -481,11 +481,11 @@ type internal Async2 with static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None - Async2.startAsTask ct computation |> ignore + Async2.queueTask ct computation |> ignore static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.startAsTask ct computation + Async2.queueTask ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None From d4a637efad560438f6cc76a2c1cc240b1a1822a5 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 11 Sep 2025 18:40:48 +0200 Subject: [PATCH 28/48] Revert "align with async" This reverts commit 20e9e7ed3004ad0bd825b0a8c4d35b687287d237. --- src/Compiler/Utilities/Async2.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 1c7ebe32bf..7ca4d2da4b 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -481,11 +481,11 @@ type internal Async2 with static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None - Async2.queueTask ct computation |> ignore + Async2.startAsTask ct computation |> ignore static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.queueTask ct computation + Async2.startAsTask ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None From db656255d608bfcfe271faed34db12f9637c3b96 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 11 Sep 2025 19:03:59 +0200 Subject: [PATCH 29/48] Start in background --- src/Compiler/Utilities/Async2.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 7ca4d2da4b..99c0c5e29a 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -481,7 +481,7 @@ type internal Async2 with static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None - Async2.startAsTask ct computation |> ignore + Async2.queueTask ct computation |> ignore static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None From 9986ddcef73ab4e9a21c3c8330087a6d9de80355 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 18 Sep 2025 09:31:59 +0200 Subject: [PATCH 30/48] wip --- src/Compiler/Driver/CompilerImports.fs | 4 ++-- src/Compiler/Facilities/DiagnosticsLogger.fs | 16 ++++++---------- src/Compiler/Facilities/DiagnosticsLogger.fsi | 8 ++------ src/Compiler/Service/FSharpProjectSnapshot.fs | 14 +++++++------- src/Compiler/Service/IncrementalBuild.fs | 8 ++++---- src/Compiler/Service/TransparentCompiler.fs | 4 ++-- 6 files changed, 23 insertions(+), 31 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 264337962d..51984a146e 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2326,8 +2326,8 @@ and [] TcImports let runMethod = match tcConfig.parallelReferenceResolution with - | ParallelReferenceResolution.On -> MultipleDiagnosticsLoggers.Parallel2 - | ParallelReferenceResolution.Off -> MultipleDiagnosticsLoggers.Sequential2 + | 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 e9f725ec25..e04cb4747a 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -922,7 +922,7 @@ type StackGuard(maxDepth: int, name: string) = // UseMultipleDiagnosticLoggers in ParseAndCheckProject.fs provides similar functionality. // We should probably adapt and reuse that code. module MultipleDiagnosticsLoggers = - let Parallel computations = + let Parallel (computations: Async2<_> seq) = let computationsWithLoggers, diagnosticsReady = [ for i, computation in computations |> Seq.indexed do @@ -932,7 +932,7 @@ module MultipleDiagnosticsLoggers = // Inject capturing logger into the computation. Signal the TaskCompletionSource when done. let computationsWithLoggers = - async { + async2 { SetThreadDiagnosticsLoggerNoUnwind logger try @@ -955,11 +955,11 @@ module MultipleDiagnosticsLoggers = finishedLogger.CommitDelayedDiagnostics target } - async { + async2 { try // We want to restore the current diagnostics context when finished. use _ = new CompilationGlobalsScope() - let! results = Async.Parallel computationsWithLoggers + let! results = Async2.Parallel computationsWithLoggers do! replayDiagnostics |> Async.AwaitTask return results finally @@ -974,8 +974,8 @@ module MultipleDiagnosticsLoggers = replayDiagnostics.Wait() } - let Sequential computations = - async { + let Sequential (computations: Async2<_> seq) = + async2 { let results = ResizeArray() for computation in computations do @@ -984,7 +984,3 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } - - let Sequential2 computations = Async2.Sequential computations - - let Parallel2 computations = Async2.Parallel computations diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index ac827d879e..215f6ac676 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -494,11 +494,7 @@ module MultipleDiagnosticsLoggers = /// 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> - - val Parallel2: computations: Async2<'T> seq -> Async2<'T array> + val Parallel: computations: Async2<'T> seq -> Async2<'T array> /// Run computations sequentially starting immediately on the current thread. - val Sequential: computations: Async<'T> seq -> Async<'T array> - - val Sequential2: computations: Async2<'T> seq -> Async2<'T array> + val Sequential: computations: Async2<'T> seq -> Async2<'T array> diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index 91a6efd472..75b128977f 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -656,33 +656,32 @@ and [] FSha ProjectSnapshotBase(projectConfig, referencedProjects, sourceFiles) |> FSharpProjectSnapshot - static member FromOptions(options: FSharpProjectOptions, getFileSnapshot, ?snapshotAccumulator) = + static member FromOptions(options: FSharpProjectOptions, getFileSnapshot: _ -> _ -> Async<_>, ?snapshotAccumulator) : Async<_> = let snapshotAccumulator = defaultArg snapshotAccumulator (Dictionary()) - async { + async2 { // TODO: check if options is a good key here if not (snapshotAccumulator.ContainsKey options) then let! sourceFiles = options.SourceFiles - |> Seq.map (getFileSnapshot options) + |> Seq.map (fun name -> async2 { return! getFileSnapshot options name }) |> MultipleDiagnosticsLoggers.Parallel let! referencedProjects = options.ReferencedProjects |> Seq.map (function | FSharpReferencedProject.FSharpReference(outputName, options) -> - async { + async2 { let! snapshot = FSharpProjectSnapshot.FromOptions(options, getFileSnapshot, snapshotAccumulator) return FSharpReferencedProjectSnapshot.FSharpReference(outputName, snapshot) } | FSharpReferencedProject.PEReference(getStamp, reader) -> - async.Return <| FSharpReferencedProjectSnapshot.PEReference(getStamp, reader) + async2 { return FSharpReferencedProjectSnapshot.PEReference(getStamp, reader) } | FSharpReferencedProject.ILModuleReference(outputName, getStamp, getReader) -> - async.Return - <| FSharpReferencedProjectSnapshot.ILModuleReference(outputName, getStamp, getReader)) + async2 { return FSharpReferencedProjectSnapshot.ILModuleReference(outputName, getStamp, getReader) }) |> MultipleDiagnosticsLoggers.Sequential @@ -720,6 +719,7 @@ and [] FSha return snapshotAccumulator[options] } + |> Async2.toAsync static member FromOptions(options: FSharpProjectOptions, documentSource: DocumentSource) = FSharpProjectSnapshot.FromOptions( diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index cc0d7720a5..8e7cd8a025 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -766,12 +766,12 @@ module IncrementalBuilderHelpers = let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> MultipleDiagnosticsLoggers.Sequential2 + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> MultipleDiagnosticsLoggers.Sequential let! tcInfos = computedBoundModels |> Seq.map (fun boundModel -> async2 { return! boundModel.GetOrComputeTcInfo() }) - |> MultipleDiagnosticsLoggers.Sequential2 + |> MultipleDiagnosticsLoggers.Sequential // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. let! latestImplFiles = @@ -783,7 +783,7 @@ module IncrementalBuilderHelpers = let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() return tcInfoExtras.latestImplFile }) - |> MultipleDiagnosticsLoggers.Parallel2 + |> MultipleDiagnosticsLoggers.Parallel let results = [ for tcInfo, latestImplFile in Seq.zip tcInfos latestImplFiles -> @@ -852,7 +852,7 @@ module IncrementalBuilderHelpers = let! partialDiagnostics = computedBoundModels |> Seq.map (fun m -> m.Diagnostics.GetOrComputeValue()) - |> MultipleDiagnosticsLoggers.Parallel2 + |> 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 adc35a2a6c..b562e75798 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1154,7 +1154,7 @@ type internal TransparentCompiler let! sources = projectSnapshot.SourceFiles |> Seq.map (fun f -> LoadSource f isExe (f.FileName = bootstrapInfo.LastFileName)) - |> MultipleDiagnosticsLoggers.Parallel2 + |> MultipleDiagnosticsLoggers.Parallel return ProjectSnapshotWithSources(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, sources |> Array.toList) @@ -1538,7 +1538,7 @@ type internal TransparentCompiler let! parsedInputs = projectSnapshot.SourceFiles |> Seq.map (ComputeParseFile projectSnapshot tcConfig) - |> MultipleDiagnosticsLoggers.Parallel2 + |> MultipleDiagnosticsLoggers.Parallel return ProjectSnapshotBase<_>(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, parsedInputs |> Array.toList) } From 3eedf5544ee2bfedb46601774e51343ec4f77250 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 18 Sep 2025 09:54:47 +0200 Subject: [PATCH 31/48] wip --- .../BuildGraphTests.fs | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 2a7a0afe3b..ab5b38f568 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -256,7 +256,7 @@ module BuildGraphTests = let rng = Random() fun n -> rng.Next n - let job phase i = async { + let job phase i = async2 { do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() @@ -266,7 +266,7 @@ module BuildGraphTests = } let work (phase: BuildPhase) = - async { + async2 { let n = 8 let logger = CapturingDiagnosticsLogger("test NodeCode") use _ = new CompilationGlobalsScope(logger, phase) @@ -298,8 +298,8 @@ module BuildGraphTests = let pickRandomPhase _ = phases[random phases.Length] Seq.init 100 pickRandomPhase |> Seq.map work - |> Async.Parallel - |> Async.RunSynchronously + |> Async2.Parallel + |> Async2.StartAsTask exception TestException @@ -367,7 +367,7 @@ module BuildGraphTests = Assert.shouldBeTrue (msg > prevError) prevError <- msg - let work i = async { + let work i = async2 { for c in 'A' .. 'F' do do! Async.SwitchToThreadPool() errorR (ExampleException $"%03d{i}{c}") @@ -377,12 +377,12 @@ module BuildGraphTests = let logger = DiagnosticsLoggerWithCallback errorCommitted use _ = UseDiagnosticsLogger logger - tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async.Ignore |> Async.RunImmediate + tasks |> Seq.take 50 |> MultipleDiagnosticsLoggers.Parallel |> Async2.Ignore |> Async2.RunImmediate // all errors committed errorCountShouldBe 300 - tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async.Ignore |> Async.RunImmediate + tasks |> Seq.skip 50 |> MultipleDiagnosticsLoggers.Sequential |> Async2.Ignore |> Async2.RunImmediate errorCountShouldBe 600 @@ -393,17 +393,17 @@ module BuildGraphTests = use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger") let tasks = [ - async { failwith "computation failed" } + async2 { failwith "computation failed" } for i in 1 .. 300 do - async { + async2 { errorR (ExampleException $"{Interlocked.Increment(&count)}") error (ExampleException $"{Interlocked.Increment(&count)}") } ] task { - do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore + do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async2.Catch |> Async2.Ignore // Diagnostics from all started tasks should be collected despite the exception. errorCountShouldBe count @@ -434,7 +434,7 @@ module BuildGraphTests = loggerShouldBe logger errorCountShouldBe 3 - let workInner = async { + let workInner = async2 { do! async.Zero() errorR TestException loggerShouldBe logger @@ -509,27 +509,27 @@ module BuildGraphTests = loggerShouldBe logger errorCountShouldBe 17 - async { + async2 { // After Async.Parallel the continuation runs in the context of the last computation that finished. do! - [ async { + [ async2 { SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] - |> Async.Parallel - |> Async.Ignore + |> Async2.Parallel + |> Async2.Ignore loggerShouldBe DiscardErrorsLogger SetThreadDiagnosticsLoggerNoUnwind logger // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. do! - [ async { + [ async2 { SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] |> MultipleDiagnosticsLoggers.Parallel - |> Async.Ignore + |> Async2.Ignore loggerShouldBe logger } - |> Async.RunImmediate + |> Async2.RunImmediate // Synchronous code will affect current context: @@ -544,13 +544,13 @@ module BuildGraphTests = SetThreadDiagnosticsLoggerNoUnwind logger // This runs in async continuation, so the context is forked. - async { + async2 { do! Async.Sleep 0 SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger do! Async.SwitchToNewThread() loggerShouldBe DiscardErrorsLogger } - |> Async.RunImmediate + |> Async2.RunImmediate loggerShouldBe logger From 24fc34924a24c5341637e2c130ace5f04bca51eb Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 18 Sep 2025 12:36:06 +0200 Subject: [PATCH 32/48] wip --- src/Compiler/Utilities/Async2.fs | 16 +++- .../BuildGraphTests.fs | 80 +++++++++++++++++-- 2 files changed, 87 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 99c0c5e29a..b4c16a6875 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -394,7 +394,7 @@ module internal Async2LowPriority = let t = Async.StartAsTask(expr, cancellationToken = ct) this.Source(t.ConfigureAwait(false)) - member inline _.Source(items: #seq<_>) : seq<_> = upcast items + member inline _.Source(items: _ seq) : _ seq = upcast items [] module internal Async2MediumPriority = @@ -542,3 +542,17 @@ type internal Async2 with if task.IsCanceled then compensation () } + + static member StartChild(computation: Async2<'T>) : Async2> = + async2 { + let ct = Async2.CancellationToken + let task = computation |> Async2.queueTask ct + return Async2Impl(fun () -> task) + } + + static member StartChildAsTask(computation: Async2<'T>) : Async2> = + async2 { + let ct = Async2.CancellationToken + let task = computation |> Async2.queueTask ct + return task + } diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index ab5b38f568..4bd5e60e07 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -12,6 +12,70 @@ open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics +module MultipleDiagnosticsLoggers = + let Parallel (computations: Async2<_> seq) = + let computationsWithLoggers, diagnosticsReady = + [ + for i, computation in computations |> Seq.indexed do + let diagnosticsReady = TaskCompletionSource<_>() + + let logger = CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}") + + // Inject capturing logger into the computation. Signal the TaskCompletionSource when done. + let computationsWithLoggers = + async2 { + 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 + } + + async2 { + try + // We want to restore the current diagnostics context when finished. + use _ = new CompilationGlobalsScope() + let! results = Async2.Parallel computationsWithLoggers + do! replayDiagnostics |> Async.AwaitTask + return results + finally + // When any of the computation throws, Async.Parallel may not start some remaining computations at all. + // We set dummy results for them to allow the task to finish and to not lose any already emitted diagnostics. + if not replayDiagnostics.IsCompleted then + let emptyLogger = CapturingDiagnosticsLogger("empty") + + for tcs in diagnosticsReady do + tcs.TrySetResult(emptyLogger) |> ignore + + replayDiagnostics.Wait() + } + + let Sequential (computations: Async2<_> seq) = + async2 { + let results = ResizeArray() + + for computation in computations do + let! result = computation + results.Add result + + return results.ToArray() + } + module BuildGraphTests = [] @@ -256,7 +320,7 @@ module BuildGraphTests = let rng = Random() fun n -> rng.Next n - let job phase i = async2 { + let job phase i : Async2 = async2 { do! random 10 |> Async.Sleep Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() @@ -264,13 +328,13 @@ module BuildGraphTests = errorR (ExampleException $"job {i}") } - + let work (phase: BuildPhase) = async2 { let n = 8 let logger = CapturingDiagnosticsLogger("test NodeCode") use _ = new CompilationGlobalsScope(logger, phase) - let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel + let x = MultipleDiagnosticsLoggers.Parallel ((Seq.init n (job phase)) : Async2<_> seq) let diags = logger.Diagnostics |> List.map fst @@ -412,7 +476,7 @@ module BuildGraphTests = [] let ``AsyncLocal diagnostics context flows correctly`` () = - let work logger = async { + let work logger = async2 { SetThreadDiagnosticsLoggerNoUnwind logger errorR TestException @@ -440,11 +504,11 @@ module BuildGraphTests = loggerShouldBe logger } - let! child = workInner |> Async.StartChild - let! childTask = workInner |> Async.StartChildAsTask + let! child = workInner |> Async2.StartChild + let! childTask = workInner |> Async2.StartChildAsTask do! child - do! childTask |> Async.AwaitTask + do! childTask errorCountShouldBe 5 } @@ -453,7 +517,7 @@ module BuildGraphTests = let logger = SimpleConcurrentLogger name work logger - Seq.init 10 init |> Async.Parallel |> Async.RunSynchronously |> ignore + Seq.init 10 init |> Async2.Parallel |> Async2.RunImmediate |> ignore let logger = SimpleConcurrentLogger "main" use _ = UseDiagnosticsLogger logger From 343dc1f9c50729fed4ce34c17940e24476207897 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 18 Sep 2025 17:48:02 +0200 Subject: [PATCH 33/48] make it public for now --- src/Compiler/Utilities/Async2.fs | 40 +++- .../FSharp.Compiler.ComponentTests.fsproj | 6 - .../BuildGraphTests.fs | 172 ++++-------------- .../FSharp.Compiler.Service.Tests.fsproj | 6 - 4 files changed, 67 insertions(+), 157 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index b4c16a6875..8f1c53d6b6 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -11,7 +11,7 @@ type Async2<'t> = abstract Start: unit -> Task<'t> abstract GetAwaiter: unit -> TaskAwaiter<'t> -module internal Async2Implementation = +module Async2Implementation = open FSharp.Core.CompilerServices.StateMachineHelpers @@ -28,13 +28,12 @@ module internal Async2Implementation = let currentContext = AsyncLocal() /// A structure that looks like an Awaiter - type internal Awaiter<'Awaiter, 'TResult + type Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion and 'Awaiter: (member get_IsCompleted: unit -> bool) and 'Awaiter: (member GetResult: unit -> 'TResult)> = 'Awaiter - type internal Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = - 'Awaitable + type Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable module Awaiter = let inline isCompleted (awaiter: ^Awaiter) : bool when ^Awaiter: (member get_IsCompleted: unit -> bool) = awaiter.get_IsCompleted () @@ -377,13 +376,13 @@ module internal Async2Implementation = member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() [] -module internal Async2AutoOpens = +module Async2AutoOpens = open Async2Implementation let async2 = Async2Builder() [] -module internal Async2LowPriority = +module Async2LowPriority = open Async2Implementation type Async2Builder with @@ -397,7 +396,7 @@ module internal Async2LowPriority = member inline _.Source(items: _ seq) : _ seq = upcast items [] -module internal Async2MediumPriority = +module Async2MediumPriority = open Async2Implementation type Async2Builder with @@ -406,7 +405,7 @@ module internal Async2MediumPriority = open Async2Implementation -type internal Async2 = +type Async2 = static member CancellationToken = currentContext.Value.Token static member UseTokenAsync() = @@ -425,7 +424,7 @@ type internal Async2 = } } -module internal Async2 = +module Async2 = let inline startWithContext context (code: Async2<_>) = let old = currentContext.Value @@ -472,7 +471,7 @@ module internal Async2 = let task = Task.FromResult value Async2Impl(fun () -> task) -type internal Async2 with +type Async2 with static member Ignore(computation: Async2<_>) : Async2 = async2 { let! _ = computation @@ -556,3 +555,24 @@ type internal Async2 with let task = computation |> Async2.queueTask ct return task } + + static member AwaitWaitHandle(waitHandle: WaitHandle) : Async2 = + async2 { + let ct = Async2.CancellationToken + + let tcs = + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) + + use _ = ct.Register(fun () -> tcs.TrySetCanceled() |> ignore) + + let callback = + WaitOrTimerCallback(fun _ timedOut -> tcs.TrySetResult(not timedOut) |> ignore) + + let handle = + ThreadPool.RegisterWaitForSingleObject(waitHandle, callback, null, -1, true) + + try + return! tcs.Task + finally + handle.Unregister(waitHandle) |> ignore + } diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 3dbe641d62..7ff1436a98 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -349,12 +349,6 @@ - - CompilerService\Async2.fs - - - CompilerService\AsyncMemoImpl.fs - diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 4bd5e60e07..608dc2c4c7 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -12,70 +12,6 @@ open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library open FSharp.Compiler.Diagnostics -module MultipleDiagnosticsLoggers = - let Parallel (computations: Async2<_> seq) = - let computationsWithLoggers, diagnosticsReady = - [ - for i, computation in computations |> Seq.indexed do - let diagnosticsReady = TaskCompletionSource<_>() - - let logger = CapturingDiagnosticsLogger($"CaptureDiagnosticsConcurrently {i}") - - // Inject capturing logger into the computation. Signal the TaskCompletionSource when done. - let computationsWithLoggers = - async2 { - 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 - } - - async2 { - try - // We want to restore the current diagnostics context when finished. - use _ = new CompilationGlobalsScope() - let! results = Async2.Parallel computationsWithLoggers - do! replayDiagnostics |> Async.AwaitTask - return results - finally - // When any of the computation throws, Async.Parallel may not start some remaining computations at all. - // We set dummy results for them to allow the task to finish and to not lose any already emitted diagnostics. - if not replayDiagnostics.IsCompleted then - let emptyLogger = CapturingDiagnosticsLogger("empty") - - for tcs in diagnosticsReady do - tcs.TrySetResult(emptyLogger) |> ignore - - replayDiagnostics.Wait() - } - - let Sequential (computations: Async2<_> seq) = - async2 { - let results = ResizeArray() - - for computation in computations do - let! result = computation - results.Add result - - return results.ToArray() - } - module BuildGraphTests = [] @@ -86,23 +22,6 @@ module BuildGraphTests = return 1 }), WeakReference(o) - // Robust GC helpers for .NET 10 timing differences - let private forceFullGc () = - GC.Collect(2, GCCollectionMode.Forced, blocking = true) - GC.WaitForPendingFinalizers() - GC.Collect(2, GCCollectionMode.Forced, blocking = true) - - let private timeoutMs = 10_000 - - let private assertEventuallyCollected (wr: WeakReference) = - let sw = Diagnostics.Stopwatch.StartNew() - let mutable alive = true - while alive && sw.ElapsedMilliseconds < int64 timeoutMs do - forceFullGc () - alive <- wr.IsAlive - if alive then Thread.Sleep 10 - Assert.shouldBeFalse wr.IsAlive - [] let ``Initialization of graph node should not have a computed value``() = let node = GraphNode(async2 { return 1 }) @@ -117,22 +36,27 @@ module BuildGraphTests = let graphNode = GraphNode(async2 { resetEventInAsync.Set() |> ignore - let! _ = Async.AwaitWaitHandle(resetEvent) + let! _ = Async2.AwaitWaitHandle(resetEvent) return 1 }) let task1 = - graphNode.GetOrComputeValue() |> Async2.startAsTaskWithoutCancellation - + async2 { + let! _ = graphNode.GetOrComputeValue() + () + } |> Async2.StartAsTask let task2 = - graphNode.GetOrComputeValue() |> Async2.startAsTaskWithoutCancellation + async2 { + let! _ = graphNode.GetOrComputeValue() + () + } |> Async2.StartAsTask resetEventInAsync.WaitOne() |> ignore resetEvent.Set() |> ignore try task1.Wait(1000) |> ignore - task2.Wait(1000) |> ignore + task2.Wait() |> ignore with | :? TimeoutException -> reraise() | _ -> () @@ -148,9 +72,9 @@ module BuildGraphTests = return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync )) + let work = Async2.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) - Async.RunImmediate(work) + Async2.RunImmediate(work) |> ignore Assert.shouldBe 1 computationCount @@ -161,9 +85,9 @@ module BuildGraphTests = let graphNode = GraphNode(async2 { return 1 }) - let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync )) + let work = Async2.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() )) - let result = Async.RunImmediate(work) + let result = Async2.RunImmediate(work) Assert.shouldNotBeEmpty result Assert.shouldBe requests result.Length @@ -178,12 +102,12 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async2.runWithoutCancellation(graphNode.GetOrComputeValue()) + Async2.RunImmediate(graphNode.GetOrComputeValue()) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) - assertEventuallyCollected weak + Assert.shouldBeFalse weak.IsAlive [] let ``Many requests to get a value asynchronously should have its computation cleaned up by the GC``() = @@ -195,12 +119,12 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async2.toAsync ))) + Async2.RunImmediate(Async2.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() ))) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) - assertEventuallyCollected weak + Assert.shouldBeFalse weak.IsAlive [] let ``A request can cancel``() = @@ -219,7 +143,7 @@ module BuildGraphTests = let ex = try - Async2.run cts.Token work + Async2.RunImmediate(work, cancellationToken = cts.Token) |> ignore failwith "Should have canceled" with @@ -234,22 +158,22 @@ module BuildGraphTests = let graphNode = GraphNode(async2 { - let! _ = Async.AwaitWaitHandle(resetEvent) + let! _ = Async2.AwaitWaitHandle(resetEvent) return 1 }) use cts = new CancellationTokenSource() let task = - async { + async2 { cts.Cancel() resetEvent.Set() |> ignore } - |> Async.StartAsTask + |> Async2.StartAsTask let ex = try - Async2.run cts.Token <| graphNode.GetOrComputeValue() + Async2.RunImmediate(graphNode.GetOrComputeValue(), cancellationToken = cts.Token) |> ignore failwith "Should have canceled" with @@ -269,7 +193,7 @@ module BuildGraphTests = let graphNode = GraphNode(async2 { computationCountBeforeSleep <- computationCountBeforeSleep + 1 - let! _ = Async.AwaitWaitHandle(resetEvent) + let! _ = Async2.AwaitWaitHandle(resetEvent) computationCount <- computationCount + 1 return 1 }) @@ -277,8 +201,8 @@ module BuildGraphTests = use cts = new CancellationTokenSource() let work = - async { - let! _ = graphNode.GetOrComputeValue() |> Async2.toAsync + async2 { + let! _ = graphNode.GetOrComputeValue() () } @@ -286,15 +210,15 @@ module BuildGraphTests = for i = 0 to requests - 1 do if i % 10 = 0 then - Async.StartAsTask(work, cancellationToken = cts.Token) + Async2.StartAsTask(work, cancellationToken = cts.Token) |> tasks.Add else - Async.StartAsTask(work) + Async2.StartAsTask(work) |> tasks.Add cts.Cancel() resetEvent.Set() |> ignore - Async.RunImmediate(work) + Async2.RunImmediate(work) |> ignore Assert.shouldBeTrue cts.IsCancellationRequested @@ -320,21 +244,21 @@ module BuildGraphTests = let rng = Random() fun n -> rng.Next n - let job phase i : Async2 = async2 { - do! random 10 |> Async.Sleep + let job phase i = async2 { + do! random 10 |> Task.Delay Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase) DiagnosticsThreadStatics.DiagnosticsLogger.DebugDisplay() |> Assert.shouldBe $"DiagnosticsLogger(CaptureDiagnosticsConcurrently {i})" errorR (ExampleException $"job {i}") } - + let work (phase: BuildPhase) = async2 { let n = 8 let logger = CapturingDiagnosticsLogger("test NodeCode") use _ = new CompilationGlobalsScope(logger, phase) - let x = MultipleDiagnosticsLoggers.Parallel ((Seq.init n (job phase)) : Async2<_> seq) + let! _ = Seq.init n (job phase) |> MultipleDiagnosticsLoggers.Parallel let diags = logger.Diagnostics |> List.map fst @@ -363,7 +287,7 @@ module BuildGraphTests = Seq.init 100 pickRandomPhase |> Seq.map work |> Async2.Parallel - |> Async2.StartAsTask + |> Async2.RunImmediate exception TestException @@ -499,7 +423,7 @@ module BuildGraphTests = errorCountShouldBe 3 let workInner = async2 { - do! async.Zero() + do! async2 { } errorR TestException loggerShouldBe logger } @@ -517,7 +441,7 @@ module BuildGraphTests = let logger = SimpleConcurrentLogger name work logger - Seq.init 10 init |> Async2.Parallel |> Async2.RunImmediate |> ignore + Seq.init 10 init |> Async2.Parallel |> Async2.runWithoutCancellation |> ignore let logger = SimpleConcurrentLogger "main" use _ = UseDiagnosticsLogger logger @@ -568,44 +492,22 @@ module BuildGraphTests = Task.WaitAll(noErrorsTask, btask, task) - Seq.init 11 (fun _ -> async { errorR TestException; loggerShouldBe logger } ) |> Async.Parallel |> Async.RunSynchronously |> ignore + Seq.init 11 (fun _ -> async2 { errorR TestException; loggerShouldBe logger } ) |> Async2.Parallel |> Async2.RunImmediate |> ignore loggerShouldBe logger errorCountShouldBe 17 async2 { - - // After Async.Parallel the continuation runs in the context of the last computation that finished. do! [ async2 { SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] |> Async2.Parallel |> Async2.Ignore - loggerShouldBe DiscardErrorsLogger - - SetThreadDiagnosticsLoggerNoUnwind logger - // On the other hand, MultipleDiagnosticsLoggers.Parallel restores caller's context. - do! - [ async2 { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger } ] - |> MultipleDiagnosticsLoggers.Parallel - |> Async2.Ignore loggerShouldBe logger } |> Async2.RunImmediate - // Synchronous code will affect current context: - - // This is synchronous, caller's context is affected - async { - SetThreadDiagnosticsLoggerNoUnwind DiscardErrorsLogger - do! Async.SwitchToNewThread() - loggerShouldBe DiscardErrorsLogger - } - |> Async.RunImmediate - loggerShouldBe DiscardErrorsLogger - SetThreadDiagnosticsLoggerNoUnwind logger // This runs in async continuation, so the context is forked. async2 { diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 60ed234405..d411f07b52 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -61,12 +61,6 @@ - - Async2.fs - - - BuildGraph.fs - From 75dc036ceb46c818521bb6aff7e7cda9a29fdfa7 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 25 Sep 2025 09:55:52 +0200 Subject: [PATCH 34/48] tail calls --- src/Compiler/Facilities/AsyncMemoize.fs | 2 +- src/Compiler/Facilities/BuildGraph.fs | 2 +- src/Compiler/Service/BackgroundCompiler.fs | 10 +- src/Compiler/Service/FSharpCheckerResults.fs | 4 +- src/Compiler/Service/IncrementalBuild.fs | 2 +- src/Compiler/Service/ServiceAnalysis.fs | 6 +- src/Compiler/Service/TransparentCompiler.fs | 10 +- src/Compiler/Service/service.fs | 2 +- src/Compiler/Utilities/Async2.fs | 310 ++++++++++-------- src/Compiler/Utilities/Cancellable.fs | 2 +- .../ModuleReaderCancellationTests.fs | 2 +- 11 files changed, 188 insertions(+), 164 deletions(-) diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index 38b308f5a4..b6a3bc250b 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -52,7 +52,7 @@ type AsyncLazy<'t> private (initial: AsyncLazyState<'t>, cancelUnawaited: bool, let detachable (work: Task<'t>) = async2 { try - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken // Using ContinueWith with a CancellationToken allows detaching from the running 'work' task. // If the current async workflow is canceled, the 'work' task will continue running independently. do! work.ContinueWith(ignore>, ct) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 7a19c4113d..8a635a0464 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -41,7 +41,7 @@ type internal GraphNode<'T> private (computation: Async2<'T>, cachedResult: Valu cachedResultNode else async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken Interlocked.Increment(&requestCount) |> ignore let mutable acquired = false diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index f2e80cfd0e..c4e151e716 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -494,7 +494,7 @@ type internal BackgroundCompiler let createAndGetBuilder (options, userOpName) = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let getBuilderNode = createBuilderNode (options, userOpName, ct) return! getBuilderNode.GetOrComputeValue() } @@ -595,7 +595,7 @@ type internal BackgroundCompiler | Some res -> return res | None -> Interlocked.Increment(&actualParseFileCount) |> ignore - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -615,7 +615,7 @@ type internal BackgroundCompiler parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) return res else - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -907,7 +907,7 @@ type internal BackgroundCompiler ) GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile ( @@ -1415,7 +1415,7 @@ type internal BackgroundCompiler async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous // builder, but costs some time. diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 6fb351efe3..2a4fc660da 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -88,7 +88,7 @@ type DelayedILModuleReader = match box this.result with | null -> async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken return lock this.gate (fun () -> @@ -3951,7 +3951,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile ( diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 8e7cd8a025..4d34e62bed 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1179,7 +1179,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let setCurrentState state cache = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken do! semaphore.WaitAsync(ct) try ct.ThrowIfCancellationRequested() diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 9dfe189372..af832c338a 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -305,7 +305,7 @@ module UnusedOpens = if checkFileResults.OpenDeclarations.Length = 0 then return [] else - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) let symbolUses = filterSymbolUses getSourceLineStr symbolUses let symbolUses = splitSymbolUses symbolUses @@ -327,7 +327,7 @@ module SimplifyNames = let getSimplifiableNames (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) = async2 { let result = ResizeArray() - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) @@ -465,7 +465,7 @@ module UnusedDeclarations = let getUnusedDeclarations (checkFileResults: FSharpCheckFileResults, isScriptFile: bool) = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let allSymbolUsesInFile = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) let unusedRanges = getUnusedDeclarationRanges allSymbolUsesInFile isScriptFile return unusedRanges diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index b562e75798..30e615f0de 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1606,8 +1606,6 @@ type internal TransparentCompiler caches.ParseAndCheckFileInProject.Get( projectSnapshot.FileKeyWithExtraFileSnapshotVersion fileName, async2 { - use! _holder = Async2.UseTokenAsync() - use _ = Activity.start "ComputeParseAndCheckFileInProject" [| Activity.Tags.fileName, fileName |> Path.GetFileName |> (!!) |] @@ -1874,8 +1872,6 @@ type internal TransparentCompiler Activity.Tags.project, projectSnapshot.ProjectFileName |> Path.GetFileName |> (!!) |] - use! _holder = Async2.UseTokenAsync() - try let availableOnDiskModifiedTime = @@ -1922,8 +1918,6 @@ type internal TransparentCompiler caches.ParseAndCheckProject.Get( projectSnapshot.FullKey, async2 { - use! _holder = Async2.UseTokenAsync() - match! ComputeBootstrapInfo projectSnapshot with | None, creationDiags -> return FSharpCheckProjectResults(projectSnapshot.ProjectFileName, None, keepAssemblyContents, creationDiags, None) @@ -1996,8 +1990,6 @@ type internal TransparentCompiler let tryGetSink (fileName: string) (projectSnapshot: ProjectSnapshot) = async2 { - use! _holder = Async2.UseTokenAsync() - match! ComputeBootstrapInfo projectSnapshot with | None, _ -> return None | Some bootstrapInfo, _creationDiags -> @@ -2104,7 +2096,7 @@ type internal TransparentCompiler : Async2 = let parseFileAsync = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let diagnostics, parsedInput, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, false, flatErrors, false, ct) diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 9411828da6..b6b5687425 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -277,7 +277,7 @@ type FSharpChecker match braceMatchCache.TryGet(AnyCallerThread, (fileName, hash, options)) with | Some res -> return res | None -> - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let res = ParseAndCheckFile.matchBraces (sourceText, fileName, options, userOpName, suggestNamesForErrors, ct) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 8f1c53d6b6..2f00811497 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -7,8 +7,12 @@ open System.Runtime.CompilerServices #nowarn 3513 -type Async2<'t> = - abstract Start: unit -> Task<'t> +type IAsync2Invocation<'t> = + abstract Task: Task<'t> + +and Async2<'t> = + abstract StartImmediate: CancellationToken -> IAsync2Invocation<'t> + abstract TailCall: CancellationToken * TaskCompletionSource<'t> voption -> unit abstract GetAwaiter: unit -> TaskAwaiter<'t> module Async2Implementation = @@ -22,11 +26,6 @@ module Async2Implementation = if not condition then failwith message - [] - type Context = { Token: CancellationToken } - - let currentContext = AsyncLocal() - /// A structure that looks like an Awaiter type Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion @@ -82,21 +81,17 @@ module Async2Implementation = member this.Ref: ICriticalNotifyCompletion ref = ref this - static member Current = holder.Value + member this.Set action = set action - [] - type DynamicContinuation = - | Stop - | Immediate - | Bounce - | Await of ICriticalNotifyCompletion + static member Current = holder.Value - [] type DynamicState = - | InitialYield | Running | SetResult | SetException of ExceptionDispatchInfo + | Awaiting of ICriticalNotifyCompletion + | Bounce of DynamicState + | Immediate of DynamicState module BindContext = [] @@ -115,8 +110,8 @@ module Async2Implementation = else false - let inline IncrementBindCountDynamic () = - if IncrementBindCount() then Bounce else Immediate + let inline IncrementBindCountDynamic next = + if IncrementBindCount() then Bounce next else Immediate next module ExceptionCache = let store = ConditionalWeakTable() @@ -145,16 +140,6 @@ module Async2Implementation = with exn -> Throw exn - [] - type Async2Impl<'T>(start: unit -> Task<'T>) = - - interface Async2<'T> with - - member _.Start() = start () - member _.GetAwaiter() = (start ()).GetAwaiter() - - //static let tailCallSource = AsyncLocal voption>() - [] type Async2Data<'t> = [] @@ -163,17 +148,59 @@ module Async2Implementation = [] val mutable MethodBuilder: AsyncTaskMethodBuilder<'t> + [] + val mutable TailCallSource: TaskCompletionSource<'t> voption + + [] + val mutable CancellationToken: CancellationToken + type Async2StateMachine<'TOverall> = ResumableStateMachine> type IAsync2StateMachine<'TOverall> = IResumableStateMachine> type Async2ResumptionFunc<'TOverall> = ResumptionFunc> type Async2ResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> + type Async2Code<'TOverall, 'T> = ResumableCode, 'T> + [] + type Async2Impl<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>> = + [] + val mutable StateMachine: 'm + + member ts.Start(ct, tc) = + let mutable copy = ts + let mutable data = Async2Data() + data.CancellationToken <- ct + data.TailCallSource <- tc + data.MethodBuilder <- AsyncTaskMethodBuilder<'t>.Create() + copy.StateMachine.Data <- data + copy.StateMachine.Data.MethodBuilder.Start(©.StateMachine) + copy :> IAsync2Invocation<'t> + + interface IAsync2Invocation<'t> with + member ts.Task = ts.StateMachine.Data.MethodBuilder.Task + + interface Async2<'t> with + member ts.StartImmediate ct = ts.Start(ct, ValueNone) + member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore + member ts.GetAwaiter() = ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() + + [] + type Async2ImplDynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: unit -> 'm) = + + member ts.Start(ct, tc) = + let mutable copy = Async2Impl(StateMachine = getCopy()) + copy.Start(ct, tc) + + interface Async2<'t> with + member ts.StartImmediate ct = ts.Start(ct, ValueNone) + member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore + member ts.GetAwaiter() = ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() + [] module Async2Code = let inline filterCancellation ([] catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> - let ct = currentContext.Value.Token + let ct = sm.Data.CancellationToken match exn with | :? OperationCanceledException as oce when ct.IsCancellationRequested || oce.CancellationToken = ct -> raise exn @@ -181,7 +208,7 @@ module Async2Implementation = let inline throwIfCancellationRequested (code: Async2Code<_, _>) = Async2Code(fun sm -> - currentContext.Value.Token.ThrowIfCancellationRequested() + sm.Data.CancellationToken.ThrowIfCancellationRequested() code.Invoke(&sm)) let inline yieldOnBindLimit () = @@ -196,6 +223,8 @@ module Async2Implementation = else true) + type CancellableAwaiter<'t, 'a when Awaiter<'a, 't>> = CancellationToken -> 'a + type Async2Builder() = member inline _.Delay(generator: unit -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = @@ -238,7 +267,6 @@ module Async2Implementation = member inline _.For(sequence: seq<'T>, [] body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) - [] static member inline BindDynamic (sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) = @@ -251,11 +279,12 @@ module Async2Implementation = (continuation result).Invoke(&sm)) sm.ResumptionDynamicInfo.ResumptionFunc <- resumptionFunc - sm.ResumptionDynamicInfo.ResumptionData <- awaiter :> ICriticalNotifyCompletion + sm.ResumptionDynamicInfo.ResumptionData <- Awaiting awaiter false - [] - member inline _.Bind(awaiter, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = + member inline _.BindAwaiter + (awaiter: Awaiter<_, _>, [] continuation: 'U -> Async2Code<'Data, 'T>) + : Async2Code<'Data, 'T> = Async2Code(fun sm -> if __useResumableCode then if Awaiter.isCompleted awaiter then @@ -272,64 +301,91 @@ module Async2Implementation = else Async2Builder.BindDynamic(&sm, awaiter, continuation)) - [] - member inline this.ReturnFrom(awaiter) : Async2Code<'T, 'T> = this.Bind(awaiter, this.Return) + member inline this.BindCancellable + ([] binding: CancellableAwaiter<'U, 'Awaiter>, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = + Async2Code(fun sm -> this.BindAwaiter(binding sm.Data.CancellationToken, continuation).Invoke(&sm) ) + + member inline this.Bind(code: Async2<'U>, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = + Async2Code(fun sm -> this.BindCancellable((fun ct -> code.StartImmediate(ct).Task.GetAwaiter()), continuation).Invoke(&sm)) + + member inline this.Bind(awaiter, [] continuation) = this.BindAwaiter(awaiter, continuation) + + member inline this.Bind(cancellable, [] continuation) = this.BindCancellable(cancellable, continuation) + + member inline this.ReturnFrom(code: Async2<'T>) : Async2Code<'T, 'T> = this.Bind(code, this.Return) + + member inline this.ReturnFrom(awaiter) = this.BindAwaiter(awaiter, this.Return) + + member inline this.ReturnFrom(cancellable) = this.BindCancellable(cancellable, this.Return) + + member inline this.ReturnFromFinal(code: Async2<'T>) = + Async2Code(fun sm -> + let __stack_ct = sm.Data.CancellationToken + match sm.Data.TailCallSource with + | ValueNone -> + // This is the start of a tail call chain. we need to return here when the entire chain is done. + let __stack_tcs = TaskCompletionSource<_>() + code.TailCall(__stack_ct, ValueSome __stack_tcs) + //Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome __stack_tcs)) + this.BindAwaiter(__stack_tcs.Task.GetAwaiter(), this.Return).Invoke(&sm) + | ValueSome tcs -> + // We are already in a tail call chain. + BindContext.ResetBindCount() + //code.TailCall(__stack_ct, ValueSome tcs) + Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome tcs)) + false // Return false to abandon this state machine and continue on the next one. + ) + + member inline this.ReturnFromFinal(awaiter) : Async2Code<'T, 'T> = this.BindAwaiter(awaiter, this.Return) + + member inline this.ReturnFromFinal(cancellable) : Async2Code<'T, 'T> = this.BindCancellable(cancellable, this.Return) static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) - let resumptionInfo () = - let mutable state = InitialYield - - { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc) with + let resumptionInfo() = + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, ResumptionData = (BindContext.IncrementBindCountDynamic Running) ) with member info.MoveNext(sm) = - let mutable continuation = Stop - let current = state + let getCurrent() = nonNull info.ResumptionData :?> DynamicState + let setState state = info.ResumptionData <- box state - match current with - | InitialYield -> - state <- Running - continuation <- BindContext.IncrementBindCountDynamic() + match getCurrent() with + | Immediate state -> + setState state + info.MoveNext &sm | Running -> + let mutable keepGoing = true try - let step = info.ResumptionFunc.Invoke(&sm) - - if step then - state <- SetResult - continuation <- BindContext.IncrementBindCountDynamic() + if info.ResumptionFunc.Invoke(&sm) then + setState (BindContext.IncrementBindCountDynamic SetResult) else - match info.ResumptionData with - | :? ICriticalNotifyCompletion as awaiter -> continuation <- Await awaiter - | _ -> failwith "invalid awaiter" + keepGoing <- getCurrent() |> _.IsAwaiting with exn -> - state <- SetException(ExceptionCache.CaptureOrRetrieve exn) - continuation <- BindContext.IncrementBindCountDynamic() - | SetResult -> sm.Data.MethodBuilder.SetResult sm.Data.Result - | SetException edi -> sm.Data.MethodBuilder.SetException(edi.SourceException) - - let continuation = continuation - - match continuation with - | Await awaiter -> - sm.ResumptionDynamicInfo.ResumptionData <- null + setState (BindContext.IncrementBindCountDynamic <| SetException(ExceptionCache.CaptureOrRetrieve exn)) + if keepGoing then info.MoveNext &sm + | Awaiting awaiter -> + setState Running let mutable awaiter = awaiter sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - | Bounce -> sm.Data.MethodBuilder.AwaitOnCompleted(Trampoline.Current.Ref, &sm) - | Immediate -> info.MoveNext &sm - | Stop -> () + | Bounce next -> + setState next + sm.Data.MethodBuilder.AwaitOnCompleted(Trampoline.Current.Ref, &sm) + | SetResult -> + match sm.Data.TailCallSource with + | ValueSome tcs -> tcs.SetResult sm.Data.Result + | _ -> sm.Data.MethodBuilder.SetResult sm.Data.Result + | SetException edi -> + match sm.Data.TailCallSource with + | ValueSome tcs -> + tcs.TrySetException(edi.SourceException) |> ignore + | _ -> sm.Data.MethodBuilder.SetException(edi.SourceException) member _.SetStateMachine(sm, state) = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2Impl(fun () -> - let mutable copy = Async2StateMachine() - copy.ResumptionDynamicInfo <- resumptionInfo () - copy.Data <- Async2Data() - copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() - copy.Data.MethodBuilder.Start(©) - copy.Data.MethodBuilder.Task) + Async2ImplDynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo())) member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then @@ -349,7 +405,9 @@ module Async2Implementation = let __stack_go2 = yieldOnBindLimit().Invoke(&sm) if __stack_go2 then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + match sm.Data.TailCallSource with + | ValueSome tcs -> tcs.SetResult sm.Data.Result + | _ -> sm.Data.MethodBuilder.SetResult(sm.Data.Result) with exn -> error <- ValueSome(ExceptionCache.CaptureOrRetrieve exn) @@ -357,23 +415,17 @@ module Async2Implementation = let __stack_go2 = yieldOnBindLimit().Invoke(&sm) if __stack_go2 then - sm.Data.MethodBuilder.SetException(error.Value.SourceException))) + match sm.Data.TailCallSource with + | ValueSome tcs -> tcs.SetException(error.Value.SourceException) + | _ -> sm.Data.MethodBuilder.SetException(error.Value.SourceException))) (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) - (AfterCode<_, _>(fun sm -> - let sm = sm - - Async2Impl(fun () -> - let mutable copy = sm - copy.Data <- Async2Data() - copy.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() - copy.Data.MethodBuilder.Start(©) - copy.Data.MethodBuilder.Task))) + (AfterCode<_, _>(fun sm -> Async2Impl<_, _>(StateMachine = sm) :> Async2<'T>)) else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code.Start().GetAwaiter() + member inline _.Source(code: Async2<_>) = code [] module Async2AutoOpens = @@ -388,11 +440,6 @@ module Async2LowPriority = type Async2Builder with member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() - member inline this.Source(expr: Async<'T>) = - let ct = currentContext.Value.Token - let t = Async.StartAsTask(expr, cancellationToken = ct) - this.Source(t.ConfigureAwait(false)) - member inline _.Source(items: _ seq) : _ seq = upcast items [] @@ -402,63 +449,43 @@ module Async2MediumPriority = type Async2Builder with member inline _.Source(task: Task) = task.ConfigureAwait(false).GetAwaiter() member inline _.Source(task: Task<_>) = task.ConfigureAwait(false).GetAwaiter() + member inline this.Source(expr: Async<'T>) : CancellableAwaiter<_, _> = + fun ct -> Async.StartAsTask(expr, cancellationToken = ct).GetAwaiter() open Async2Implementation -type Async2 = - static member CancellationToken = currentContext.Value.Token - - static member UseTokenAsync() = - async { - let! ct = Async.CancellationToken - let old = currentContext.Value.Token - currentContext.Value <- { currentContext.Value with Token = ct } - - return - { new IDisposable with - member _.Dispose() = - currentContext.Value <- - { currentContext.Value with - Token = old - } - } - } - module Async2 = - let inline startWithContext context (code: Async2<_>) = - let old = currentContext.Value - currentContext.Value <- context + let CheckAndThrowToken = AsyncLocal() - try - // Only bound computations can participate in trampolining, otherwise we risk sync over async deadlocks. - // To prevent this, we reset the bind count here. - // This computation will not initially bounce, even if it is nested inside another async2 computation. - BindContext.ResetBindCount() - code.Start() - finally - currentContext.Value <- old + let inline start (code: Async2<_>) ct = + CheckAndThrowToken.Value <- ct + // Only bound computations can participate in trampolining, otherwise we risk sync over async deadlocks. + // To prevent this, we reset the bind count here. + // This computation will not initially bounce, even if it is nested inside another async2 computation. + BindContext.ResetBindCount() + code.StartImmediate ct let run ct (code: Async2<'t>) = - let context = { Token = ct } if isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - (code |> startWithContext context).GetAwaiter().GetResult() + start code ct |> _.Task.GetAwaiter().GetResult() else - Task.Run<'t>(fun () -> code |> startWithContext context).GetAwaiter().GetResult() + Task.Run<'t>(fun () -> start code ct |> _.Task).GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code - let startAsTaskWithoutCancellation code = - startWithContext { Token = CancellationToken.None } code + let startAsTaskWithoutCancellation code = start code CancellationToken.None - let startAsTask ct code = startWithContext { Token = ct } code + let startAsTask ct code = start code ct |> _.Task + + let queue ct code = Task.Run(fun () -> start code ct) let queueTask ct code = - Task.Run<'t>(fun () -> startWithContext { Token = ct } code) + Task.Run<'t>(fun () -> startAsTask ct code) let toAsync (code: Async2<'t>) = async { @@ -467,11 +494,16 @@ module Async2 = return! Async.AwaitTask task } - let fromValue (value: 't) : Async2<'t> = - let task = Task.FromResult value - Async2Impl(fun () -> task) + let fromValue (value: 't) : Async2<'t> = async2 { return value } + + let CancellationToken = + async2.Run( + Async2Code(fun sm -> + sm.Data.Result <- sm.Data.CancellationToken + true) + ) -type Async2 with +type Async2 = static member Ignore(computation: Async2<_>) : Async2 = async2 { let! _ = computation @@ -492,7 +524,8 @@ type Async2 with static member Parallel(computations: Async2<_> seq) = async2 { - use lcts = CancellationTokenSource.CreateLinkedTokenSource Async2.CancellationToken + let! ct = Async2.CancellationToken + use lcts = CancellationTokenSource.CreateLinkedTokenSource ct let tasks = seq { @@ -532,7 +565,7 @@ type Async2 with static member TryCancelled(computation: Async2<'T>, compensation) = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let task = computation |> Async2.startAsTask ct try @@ -544,21 +577,20 @@ type Async2 with static member StartChild(computation: Async2<'T>) : Async2> = async2 { - let ct = Async2.CancellationToken - let task = computation |> Async2.queueTask ct - return Async2Impl(fun () -> task) + let! ct = Async2.CancellationToken + return async2 { return! computation |> Async2.queueTask ct } } static member StartChildAsTask(computation: Async2<'T>) : Async2> = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let task = computation |> Async2.queueTask ct return task } static member AwaitWaitHandle(waitHandle: WaitHandle) : Async2 = async2 { - let ct = Async2.CancellationToken + let! ct = Async2.CancellationToken let tcs = TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 812db9e369..fa70be53eb 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -7,4 +7,4 @@ type Cancellable = static member CheckAndThrow() = // If we're not inside an async computation, the ambient cancellation token will be CancellationToken.None and nothing will happen // otherwise, if we are inside an async computation, this will throw. - Async2.CancellationToken.ThrowIfCancellationRequested() + Async2.CheckAndThrowToken.Value.ThrowIfCancellationRequested() diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index 9b04ad0984..2dd72a0b93 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -150,7 +150,7 @@ let parseAndCheck path source options = | _, FSharpCheckFileAnswer.Aborted -> None | _, FSharpCheckFileAnswer.Succeeded results -> Some results - Async2.CancellationToken |> shouldEqual CancellationToken.None + Async2.CheckAndThrowToken.Value |> shouldEqual CancellationToken.None result with :? OperationCanceledException -> From 6fb05fce65e7947e4c964df22e35b644c36ebc96 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 25 Sep 2025 10:14:42 +0200 Subject: [PATCH 35/48] temp bsl --- ...iler.Service.SurfaceArea.netstandard20.bsl | 176 +++++++++++++++++- 1 file changed, 175 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index bfc1deda2a..db03c9303d 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12423,12 +12423,186 @@ FSharp.Compiler.Xml.XmlDoc: System.String[] GetElaboratedXmlLines() FSharp.Compiler.Xml.XmlDoc: System.String[] UnprocessedLines FSharp.Compiler.Xml.XmlDoc: System.String[] get_UnprocessedLines() FSharp.Compiler.Xml.XmlDoc: Void .ctor(System.String[], FSharp.Compiler.Text.Range) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[Internal.Utilities.Library.Async2`1[T]] StartChild[T](Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[Microsoft.FSharp.Core.Unit] Ignore[a](Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[System.Boolean] AwaitWaitHandle(System.Threading.WaitHandle) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[System.Threading.Tasks.Task`1[T]] StartChildAsTask[T](Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[T] TryCancelled[T](Internal.Utilities.Library.Async2`1[T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[a[]] Parallel[a](System.Collections.Generic.IEnumerable`1[Internal.Utilities.Library.Async2`1[a]]) +Internal.Utilities.Library.Async2: Internal.Utilities.Library.Async2`1[a[]] Sequential[a](System.Collections.Generic.IEnumerable`1[Internal.Utilities.Library.Async2`1[a]]) +Internal.Utilities.Library.Async2: System.Threading.Tasks.Task`1[a] StartAsTask[a](Internal.Utilities.Library.Async2`1[a], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) +Internal.Utilities.Library.Async2: T RunImmediate[T](Internal.Utilities.Library.Async2`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) +Internal.Utilities.Library.Async2: Void Start[a](Internal.Utilities.Library.Async2`1[a], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) +Internal.Utilities.Library.Async2AutoOpens: Async2Builder async2 +Internal.Utilities.Library.Async2AutoOpens: Async2Builder get_async2() +Internal.Utilities.Library.Async2Implementation+Async2Builder: Boolean BindDynamic$W[t,a1,a2,a3](Microsoft.FSharp.Core.FSharpFunc`2[a1,a2], Microsoft.FSharp.Core.FSharpFunc`2[a1,System.Boolean], Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]] ByRef, a1, Microsoft.FSharp.Core.FSharpFunc`2[a2,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t],a3]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Boolean BindDynamic[t,a1,a2,a3](Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]] ByRef, a1, Microsoft.FSharp.Core.FSharpFunc`2[a2,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t],a3]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[T] RunDynamic[T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[T] Run[T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[a] Source[a](Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindAwaiter$W[s,U,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[s,U], Microsoft.FSharp.Core.FSharpFunc`2[s,System.Boolean], s, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindAwaiter[s,U,Data,T](s, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindCancellable$W[U,Awaiter,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,U], Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Awaiter], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindCancellable[U,Awaiter,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Awaiter], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] Bind[U,Data,T](Internal.Utilities.Library.Async2`1[U], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] For[T,TOverall](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] While[TOverall](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] Zero[TOverall]() +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] Combine[TOverall,T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit], Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] Delay[TOverall,T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] TryFinally[TOverall,T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] TryWith[TOverall,T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] Using[Resource,TOverall,T](Resource, Microsoft.FSharp.Core.FSharpFunc`2[Resource,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal$W[T,b](Microsoft.FSharp.Core.FSharpFunc`2[b,T], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,b]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal$W[c,T](Microsoft.FSharp.Core.FSharpFunc`2[c,T], Microsoft.FSharp.Core.FSharpFunc`2[c,System.Boolean], c) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal[T,b](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,b]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal[c,T](c) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFrom[T](Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],a4] Return[T,a4](T) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],d] ReturnFromFinal[T,d](Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[e],g] ReturnFrom$W[e,f,g](Microsoft.FSharp.Core.FSharpFunc`2[f,e], Microsoft.FSharp.Core.FSharpFunc`2[f,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,f]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[e],g] ReturnFrom[e,f,g](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,f]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[i],j] ReturnFrom$W[h,i,j](Microsoft.FSharp.Core.FSharpFunc`2[h,i], Microsoft.FSharp.Core.FSharpFunc`2[h,System.Boolean], h) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[i],j] ReturnFrom[h,i,j](h) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n] Bind$W[k,l,m,n](Microsoft.FSharp.Core.FSharpFunc`2[l,k], Microsoft.FSharp.Core.FSharpFunc`2[l,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,l], Microsoft.FSharp.Core.FSharpFunc`2[k,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n] Bind[k,l,m,n](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,l], Microsoft.FSharp.Core.FSharpFunc`2[k,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r] Bind$W[o,p,q,r](Microsoft.FSharp.Core.FSharpFunc`2[o,p], Microsoft.FSharp.Core.FSharpFunc`2[o,System.Boolean], o, Microsoft.FSharp.Core.FSharpFunc`2[p,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r] Bind[o,p,q,r](o, Microsoft.FSharp.Core.FSharpFunc`2[p,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Void .ctor() +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] yieldOnBindLimit[a,b]() +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] filterCancellation[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]], System.Exception) +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] throwIfCancellationRequested[a,b,c](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(System.Object) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Int32 GetHashCode() +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]] TailCallSource +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1[t] MethodBuilder +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Threading.CancellationToken CancellationToken +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: t Result +Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) +Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,m]) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(Async2Impl`2) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(Async2Impl`2, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(System.Object) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Int32 GetHashCode() +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) +Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: m StateMachine +Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted$W[Awaiter](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,System.Boolean], Awaiter) +Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted[Awaiter](Awaiter) +Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult$W[Awaiter,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,TResult], Awaiter) +Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult[Awaiter,TResult](Awaiter) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void onCompleted[Awaiter](Awaiter, System.Action) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted[Awaiter](Awaiter, System.Action) +Internal.Utilities.Library.Async2Implementation+BindContext: Boolean IncrementBindCount() +Internal.Utilities.Library.Async2Implementation+BindContext: DynamicState IncrementBindCountDynamic(DynamicState) +Internal.Utilities.Library.Async2Implementation+BindContext: Int32 bindLimit +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] bindCount +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() +Internal.Utilities.Library.Async2Implementation+BindContext: Void ResetBindCount() +Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion Item +Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion get_Item() +Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce: DynamicState Item +Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce: DynamicState get_Item() +Internal.Utilities.Library.Async2Implementation+DynamicState+Immediate: DynamicState Item +Internal.Utilities.Library.Async2Implementation+DynamicState+Immediate: DynamicState get_Item() +Internal.Utilities.Library.Async2Implementation+DynamicState+SetException: System.Runtime.ExceptionServices.ExceptionDispatchInfo Item +Internal.Utilities.Library.Async2Implementation+DynamicState+SetException: System.Runtime.ExceptionServices.ExceptionDispatchInfo get_Item() +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 Awaiting +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 Bounce +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 Immediate +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 Running +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 SetException +Internal.Utilities.Library.Async2Implementation+DynamicState+Tags: Int32 SetResult +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean Equals(DynamicState) +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean Equals(DynamicState, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean Equals(System.Object) +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsAwaiting +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsBounce +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsImmediate +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsRunning +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsSetException +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean IsSetResult +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsAwaiting() +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsBounce() +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsImmediate() +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsRunning() +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsSetException() +Internal.Utilities.Library.Async2Implementation+DynamicState: Boolean get_IsSetResult() +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState NewAwaiting(System.Runtime.CompilerServices.ICriticalNotifyCompletion) +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState NewBounce(DynamicState) +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState NewImmediate(DynamicState) +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState NewSetException(System.Runtime.ExceptionServices.ExceptionDispatchInfo) +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState Running +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState SetResult +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState get_Running() +Internal.Utilities.Library.Async2Implementation+DynamicState: DynamicState get_SetResult() +Internal.Utilities.Library.Async2Implementation+DynamicState: Int32 GetHashCode() +Internal.Utilities.Library.Async2Implementation+DynamicState: Int32 GetHashCode(System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+DynamicState: Int32 Tag +Internal.Utilities.Library.Async2Implementation+DynamicState: Int32 get_Tag() +Internal.Utilities.Library.Async2Implementation+DynamicState: Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting +Internal.Utilities.Library.Async2Implementation+DynamicState: Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce +Internal.Utilities.Library.Async2Implementation+DynamicState: Internal.Utilities.Library.Async2Implementation+DynamicState+Immediate +Internal.Utilities.Library.Async2Implementation+DynamicState: Internal.Utilities.Library.Async2Implementation+DynamicState+SetException +Internal.Utilities.Library.Async2Implementation+DynamicState: Internal.Utilities.Library.Async2Implementation+DynamicState+Tags +Internal.Utilities.Library.Async2Implementation+DynamicState: System.String ToString() +Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.CompilerServices.ConditionalWeakTable`2[System.Exception,System.Runtime.ExceptionServices.ExceptionDispatchInfo] get_store() +Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.CompilerServices.ConditionalWeakTable`2[System.Exception,System.Runtime.ExceptionServices.ExceptionDispatchInfo] store +Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.ExceptionServices.ExceptionDispatchInfo CaptureOrRetrieve(System.Exception) +Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) +Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], a) +Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) +Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref +Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] get_Ref() +Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline Current +Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline get_Current() +Internal.Utilities.Library.Async2Implementation+Trampoline: Void Set(System.Action) +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Builder +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Code +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Data`1[t] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaiter +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+BindContext +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+DynamicState +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+ExceptionCache +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Trampoline +Internal.Utilities.Library.Async2Implementation: Void failIfNot(Boolean, System.String) +Internal.Utilities.Library.Async2LowPriority: System.Collections.Generic.IEnumerable`1[a] Async2Builder.Source[a](Async2Builder, System.Collections.Generic.IEnumerable`1[a]) +Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source$W[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a) +Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source[a,b,c](Async2Builder, a) +Internal.Utilities.Library.Async2MediumPriority: ConfiguredTaskAwaiter Async2Builder.Source(Async2Builder, System.Threading.Tasks.Task) +Internal.Utilities.Library.Async2MediumPriority: ConfiguredTaskAwaiter Async2Builder.Source[a](Async2Builder, System.Threading.Tasks.Task`1[a]) +Internal.Utilities.Library.Async2MediumPriority: Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,System.Runtime.CompilerServices.TaskAwaiter`1[T]] Async2Builder.Source[T](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[T]) +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] startAsTaskWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] start[a](Internal.Utilities.Library.Async2`1[a], System.Threading.CancellationToken) +Internal.Utilities.Library.Async2Module: Microsoft.FSharp.Control.FSharpAsync`1[t] toAsync[t](Internal.Utilities.Library.Async2`1[t]) +Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] CheckAndThrowToken +Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] get_CheckAndThrowToken() +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[Internal.Utilities.Library.IAsync2Invocation`1[a]] queue[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] startAsTask[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] queueTask[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) +Internal.Utilities.Library.Async2Module: a runWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: t run[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) +Internal.Utilities.Library.Async2`1[t]: Internal.Utilities.Library.IAsync2Invocation`1[t] StartImmediate(System.Threading.CancellationToken) Internal.Utilities.Library.Async2`1[t]: System.Runtime.CompilerServices.TaskAwaiter`1[t] GetAwaiter() -Internal.Utilities.Library.Async2`1[t]: System.Threading.Tasks.Task`1[t] Start() +Internal.Utilities.Library.Async2`1[t]: Void TailCall(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] CreateDictionary(T[]) Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] GetDictionary() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: T[] GetArray() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T[]]) +Internal.Utilities.Library.IAsync2Invocation`1[t]: System.Threading.Tasks.Task`1[t] Task +Internal.Utilities.Library.IAsync2Invocation`1[t]: System.Threading.Tasks.Task`1[t] get_Task() Internal.Utilities.Library.InterruptibleLazy: T force[T](Internal.Utilities.Library.InterruptibleLazy`1[T]) Internal.Utilities.Library.InterruptibleLazy`1[T]: Boolean IsValueCreated Internal.Utilities.Library.InterruptibleLazy`1[T]: Boolean get_IsValueCreated() From b60802f74dde11bbcde4d5c06e75d6f8c5491da0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 25 Sep 2025 10:20:59 +0200 Subject: [PATCH 36/48] format --- src/Compiler/Utilities/Async2.fs | 56 +++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 2f00811497..122bd120c0 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -182,19 +182,23 @@ module Async2Implementation = interface Async2<'t> with member ts.StartImmediate ct = ts.Start(ct, ValueNone) member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore - member ts.GetAwaiter() = ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() + + member ts.GetAwaiter() = + ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() [] type Async2ImplDynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: unit -> 'm) = member ts.Start(ct, tc) = - let mutable copy = Async2Impl(StateMachine = getCopy()) + let mutable copy = Async2Impl(StateMachine = getCopy ()) copy.Start(ct, tc) interface Async2<'t> with member ts.StartImmediate ct = ts.Start(ct, ValueNone) member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore - member ts.GetAwaiter() = ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() + + member ts.GetAwaiter() = + ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() [] module Async2Code = @@ -302,25 +306,29 @@ module Async2Implementation = Async2Builder.BindDynamic(&sm, awaiter, continuation)) member inline this.BindCancellable - ([] binding: CancellableAwaiter<'U, 'Awaiter>, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = - Async2Code(fun sm -> this.BindAwaiter(binding sm.Data.CancellationToken, continuation).Invoke(&sm) ) + ([] binding: CancellableAwaiter<'U, 'Awaiter>, [] continuation: 'U -> Async2Code<'Data, 'T>) + : Async2Code<'Data, 'T> = + Async2Code(fun sm -> this.BindAwaiter(binding sm.Data.CancellationToken, continuation).Invoke(&sm)) member inline this.Bind(code: Async2<'U>, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = Async2Code(fun sm -> this.BindCancellable((fun ct -> code.StartImmediate(ct).Task.GetAwaiter()), continuation).Invoke(&sm)) member inline this.Bind(awaiter, [] continuation) = this.BindAwaiter(awaiter, continuation) - member inline this.Bind(cancellable, [] continuation) = this.BindCancellable(cancellable, continuation) + member inline this.Bind(cancellable, [] continuation) = + this.BindCancellable(cancellable, continuation) member inline this.ReturnFrom(code: Async2<'T>) : Async2Code<'T, 'T> = this.Bind(code, this.Return) member inline this.ReturnFrom(awaiter) = this.BindAwaiter(awaiter, this.Return) - member inline this.ReturnFrom(cancellable) = this.BindCancellable(cancellable, this.Return) + member inline this.ReturnFrom(cancellable) = + this.BindCancellable(cancellable, this.Return) member inline this.ReturnFromFinal(code: Async2<'T>) = Async2Code(fun sm -> let __stack_ct = sm.Data.CancellationToken + match sm.Data.TailCallSource with | ValueNone -> // This is the start of a tail call chain. we need to return here when the entire chain is done. @@ -338,32 +346,42 @@ module Async2Implementation = member inline this.ReturnFromFinal(awaiter) : Async2Code<'T, 'T> = this.BindAwaiter(awaiter, this.Return) - member inline this.ReturnFromFinal(cancellable) : Async2Code<'T, 'T> = this.BindCancellable(cancellable, this.Return) + member inline this.ReturnFromFinal(cancellable) : Async2Code<'T, 'T> = + this.BindCancellable(cancellable, this.Return) static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) - let resumptionInfo() = - { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, ResumptionData = (BindContext.IncrementBindCountDynamic Running) ) with + let resumptionInfo () = + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, + ResumptionData = (BindContext.IncrementBindCountDynamic Running)) with member info.MoveNext(sm) = - let getCurrent() = nonNull info.ResumptionData :?> DynamicState + let getCurrent () = + nonNull info.ResumptionData :?> DynamicState + let setState state = info.ResumptionData <- box state - match getCurrent() with + match getCurrent () with | Immediate state -> setState state info.MoveNext &sm | Running -> let mutable keepGoing = true + try if info.ResumptionFunc.Invoke(&sm) then - setState (BindContext.IncrementBindCountDynamic SetResult) + setState (BindContext.IncrementBindCountDynamic SetResult) else - keepGoing <- getCurrent() |> _.IsAwaiting + keepGoing <- getCurrent () |> _.IsAwaiting with exn -> - setState (BindContext.IncrementBindCountDynamic <| SetException(ExceptionCache.CaptureOrRetrieve exn)) - if keepGoing then info.MoveNext &sm + setState ( + BindContext.IncrementBindCountDynamic + <| SetException(ExceptionCache.CaptureOrRetrieve exn) + ) + + if keepGoing then + info.MoveNext &sm | Awaiting awaiter -> setState Running let mutable awaiter = awaiter @@ -377,15 +395,14 @@ module Async2Implementation = | _ -> sm.Data.MethodBuilder.SetResult sm.Data.Result | SetException edi -> match sm.Data.TailCallSource with - | ValueSome tcs -> - tcs.TrySetException(edi.SourceException) |> ignore + | ValueSome tcs -> tcs.TrySetException(edi.SourceException) |> ignore | _ -> sm.Data.MethodBuilder.SetException(edi.SourceException) member _.SetStateMachine(sm, state) = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2ImplDynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo())) + Async2ImplDynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo ())) member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then @@ -449,6 +466,7 @@ module Async2MediumPriority = type Async2Builder with member inline _.Source(task: Task) = task.ConfigureAwait(false).GetAwaiter() member inline _.Source(task: Task<_>) = task.ConfigureAwait(false).GetAwaiter() + member inline this.Source(expr: Async<'T>) : CancellableAwaiter<_, _> = fun ct -> Async.StartAsTask(expr, cancellationToken = ct).GetAwaiter() From 6133ca015a3808a622b97c24c0951396a8c16557 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 25 Sep 2025 11:34:03 +0200 Subject: [PATCH 37/48] simplify a bit --- src/Compiler/Utilities/Async2.fs | 72 +++++++++---------- ...iler.Service.SurfaceArea.netstandard20.bsl | 13 ++-- 2 files changed, 36 insertions(+), 49 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 122bd120c0..bfc2910a89 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -45,12 +45,25 @@ module Async2Implementation = let inline unsafeOnCompleted (awaiter: ^Awaiter) (continuation: Action) : unit when ^Awaiter :> ICriticalNotifyCompletion = awaiter.UnsafeOnCompleted continuation + type DynamicState = + | Running + | SetResult + | SetException of ExceptionDispatchInfo + | Awaiting of ICriticalNotifyCompletion + | Bounce of DynamicState + | Immediate of DynamicState + type Trampoline private () = let ownerThreadId = Thread.CurrentThread.ManagedThreadId static let holder = new ThreadLocal<_>(fun () -> Trampoline()) + [] + static let bindLimit = 100 + + let mutable bindCount = 0 + let mutable pending: Action voption = ValueNone let mutable running = false @@ -70,6 +83,8 @@ module Async2Implementation = failIfNot (Thread.CurrentThread.ManagedThreadId = ownerThreadId) "Trampoline used from wrong thread" failIfNot pending.IsNone "Trampoline used while already pending" + bindCount <- 0 + if running then pending <- ValueSome action else @@ -83,35 +98,13 @@ module Async2Implementation = member this.Set action = set action - static member Current = holder.Value + member this.Reset() = bindCount <- 0 - type DynamicState = - | Running - | SetResult - | SetException of ExceptionDispatchInfo - | Awaiting of ICriticalNotifyCompletion - | Bounce of DynamicState - | Immediate of DynamicState - - module BindContext = - [] - let bindLimit = 100 - - let bindCount = new ThreadLocal() - - let inline ResetBindCount () = bindCount.Value <- 0 + member _.IncrementBindCount() = + bindCount <- bindCount + 1 + bindCount >= bindLimit - let inline IncrementBindCount () = - bindCount.Value <- bindCount.Value + 1 - - if bindCount.Value >= bindLimit then - ResetBindCount() - true - else - false - - let inline IncrementBindCountDynamic next = - if IncrementBindCount() then Bounce next else Immediate next + static member Current = holder.Value module ExceptionCache = let store = ConditionalWeakTable() @@ -217,7 +210,7 @@ module Async2Implementation = let inline yieldOnBindLimit () = Async2Code<_, _>(fun sm -> - if BindContext.IncrementBindCount() then + if Trampoline.Current.IncrementBindCount() then let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) if not __stack_yield_fin then @@ -334,12 +327,9 @@ module Async2Implementation = // This is the start of a tail call chain. we need to return here when the entire chain is done. let __stack_tcs = TaskCompletionSource<_>() code.TailCall(__stack_ct, ValueSome __stack_tcs) - //Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome __stack_tcs)) this.BindAwaiter(__stack_tcs.Task.GetAwaiter(), this.Return).Invoke(&sm) | ValueSome tcs -> // We are already in a tail call chain. - BindContext.ResetBindCount() - //code.TailCall(__stack_ct, ValueSome tcs) Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome tcs)) false // Return false to abandon this state machine and continue on the next one. ) @@ -352,15 +342,20 @@ module Async2Implementation = static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) + let maybeBounce state = + if Trampoline.Current.IncrementBindCount() then + Bounce state + else + Immediate state + let resumptionInfo () = - { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, - ResumptionData = (BindContext.IncrementBindCountDynamic Running)) with + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, ResumptionData = (maybeBounce Running)) with member info.MoveNext(sm) = let getCurrent () = nonNull info.ResumptionData :?> DynamicState - let setState state = info.ResumptionData <- box state + let setState state = info.ResumptionData <- state match getCurrent () with | Immediate state -> @@ -371,14 +366,11 @@ module Async2Implementation = try if info.ResumptionFunc.Invoke(&sm) then - setState (BindContext.IncrementBindCountDynamic SetResult) + setState (maybeBounce SetResult) else keepGoing <- getCurrent () |> _.IsAwaiting with exn -> - setState ( - BindContext.IncrementBindCountDynamic - <| SetException(ExceptionCache.CaptureOrRetrieve exn) - ) + setState (maybeBounce <| SetException(ExceptionCache.CaptureOrRetrieve exn)) if keepGoing then info.MoveNext &sm @@ -481,7 +473,7 @@ module Async2 = // Only bound computations can participate in trampolining, otherwise we risk sync over async deadlocks. // To prevent this, we reset the bind count here. // This computation will not initially bounce, even if it is nested inside another async2 computation. - BindContext.ResetBindCount() + Trampoline.Current.Reset() code.StartImmediate ct let run ct (code: Async2<'t>) = diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index db03c9303d..f956b885e6 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12499,12 +12499,6 @@ Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult$W[Awa Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult[Awaiter,TResult](Awaiter) Internal.Utilities.Library.Async2Implementation+Awaiter: Void onCompleted[Awaiter](Awaiter, System.Action) Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted[Awaiter](Awaiter, System.Action) -Internal.Utilities.Library.Async2Implementation+BindContext: Boolean IncrementBindCount() -Internal.Utilities.Library.Async2Implementation+BindContext: DynamicState IncrementBindCountDynamic(DynamicState) -Internal.Utilities.Library.Async2Implementation+BindContext: Int32 bindLimit -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] bindCount -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() -Internal.Utilities.Library.Async2Implementation+BindContext: Void ResetBindCount() Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion Item Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion get_Item() Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce: DynamicState Item @@ -12559,10 +12553,12 @@ Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.E Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], a) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) +Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean IncrementBindCount() Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] get_Ref() Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline Current Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline get_Current() +Internal.Utilities.Library.Async2Implementation+Trampoline: Void Reset() Internal.Utilities.Library.Async2Implementation+Trampoline: Void Set(System.Action) Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Builder Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Code @@ -12570,7 +12566,6 @@ Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Asyn Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaiter -Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+BindContext Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+DynamicState Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+ExceptionCache Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Trampoline @@ -12578,9 +12573,9 @@ Internal.Utilities.Library.Async2Implementation: Void failIfNot(Boolean, System. Internal.Utilities.Library.Async2LowPriority: System.Collections.Generic.IEnumerable`1[a] Async2Builder.Source[a](Async2Builder, System.Collections.Generic.IEnumerable`1[a]) Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source$W[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a) Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source[a,b,c](Async2Builder, a) -Internal.Utilities.Library.Async2MediumPriority: ConfiguredTaskAwaiter Async2Builder.Source(Async2Builder, System.Threading.Tasks.Task) -Internal.Utilities.Library.Async2MediumPriority: ConfiguredTaskAwaiter Async2Builder.Source[a](Async2Builder, System.Threading.Tasks.Task`1[a]) Internal.Utilities.Library.Async2MediumPriority: Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,System.Runtime.CompilerServices.TaskAwaiter`1[T]] Async2Builder.Source[T](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[T]) +Internal.Utilities.Library.Async2MediumPriority: System.Runtime.CompilerServices.TaskAwaiter Async2Builder.Source(Async2Builder, System.Threading.Tasks.Task) +Internal.Utilities.Library.Async2MediumPriority: System.Runtime.CompilerServices.TaskAwaiter`1[a] Async2Builder.Source[a](Async2Builder, System.Threading.Tasks.Task`1[a]) Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) From ef15724c8d0b01a52a189dedf6eebb1b5305f433 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 26 Sep 2025 10:41:29 +0200 Subject: [PATCH 38/48] sort out overloads again --- src/Compiler/Utilities/Async2.fs | 229 +++++++++++++++---------------- 1 file changed, 110 insertions(+), 119 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index bfc2910a89..7f68454b96 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -4,11 +4,14 @@ open System open System.Threading open System.Threading.Tasks open System.Runtime.CompilerServices +open FSharp.Core.CompilerServices.StateMachineHelpers +open Microsoft.FSharp.Core.CompilerServices #nowarn 3513 type IAsync2Invocation<'t> = abstract Task: Task<'t> + abstract GetAwaiter: unit -> TaskAwaiter<'t> and Async2<'t> = abstract StartImmediate: CancellationToken -> IAsync2Invocation<'t> @@ -17,9 +20,6 @@ and Async2<'t> = module Async2Implementation = - open FSharp.Core.CompilerServices.StateMachineHelpers - - open Microsoft.FSharp.Core.CompilerServices open System.Runtime.ExceptionServices let failIfNot condition message = @@ -35,15 +35,16 @@ module Async2Implementation = type Awaitable<'Awaitable, 'Awaiter, 'TResult when 'Awaitable: (member GetAwaiter: unit -> Awaiter<'Awaiter, 'TResult>)> = 'Awaitable module Awaiter = - let inline isCompleted (awaiter: ^Awaiter) : bool when ^Awaiter: (member get_IsCompleted: unit -> bool) = awaiter.get_IsCompleted () + let inline isCompleted (awaiter: Awaiter<_, _>) = awaiter.get_IsCompleted () - let inline getResult (awaiter: ^Awaiter) : ^TResult when ^Awaiter: (member GetResult: unit -> ^TResult) = awaiter.GetResult() + let inline getResult (awaiter: Awaiter<_, _>) = awaiter.GetResult() - let inline onCompleted (awaiter: ^Awaiter) (continuation: Action) : unit when ^Awaiter :> INotifyCompletion = - awaiter.OnCompleted continuation + let inline onCompleted (awaiter: Awaiter<_, _>) continuation = awaiter.OnCompleted continuation - let inline unsafeOnCompleted (awaiter: ^Awaiter) (continuation: Action) : unit when ^Awaiter :> ICriticalNotifyCompletion = - awaiter.UnsafeOnCompleted continuation + let inline unsafeOnCompleted (awaiter: Awaiter<_, _>) continuation = awaiter.UnsafeOnCompleted continuation + + module Awaitable = + let inline getAwaiter (awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() type DynamicState = | Running @@ -91,8 +92,8 @@ module Async2Implementation = start action interface ICriticalNotifyCompletion with - member _.OnCompleted(continuation) = set continuation - member _.UnsafeOnCompleted(continuation) = set continuation + member _.OnCompleted continuation = set continuation + member _.UnsafeOnCompleted continuation = set continuation member this.Ref: ICriticalNotifyCompletion ref = ref this @@ -155,7 +156,7 @@ module Async2Implementation = type Async2Code<'TOverall, 'T> = ResumableCode, 'T> [] - type Async2Impl<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>> = + type Async2<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>> = [] val mutable StateMachine: 'm @@ -172,26 +173,24 @@ module Async2Implementation = interface IAsync2Invocation<'t> with member ts.Task = ts.StateMachine.Data.MethodBuilder.Task + member ts.GetAwaiter() = + ts.StateMachine.Data.MethodBuilder.Task.GetAwaiter() + interface Async2<'t> with member ts.StartImmediate ct = ts.Start(ct, ValueNone) member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore member ts.GetAwaiter() = - ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() - - [] - type Async2ImplDynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: unit -> 'm) = + ts.Start(CancellationToken.None, ValueNone).GetAwaiter() - member ts.Start(ct, tc) = - let mutable copy = Async2Impl(StateMachine = getCopy ()) - copy.Start(ct, tc) + type Async2Dynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: unit -> 'm) = + member ts.GetCopy() = + Async2(StateMachine = getCopy ()) :> Async2<_> interface Async2<'t> with - member ts.StartImmediate ct = ts.Start(ct, ValueNone) - member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore - - member ts.GetAwaiter() = - ts.Start(CancellationToken.None, ValueNone).Task.GetAwaiter() + member ts.StartImmediate ct = ts.GetCopy().StartImmediate(ct) + member ts.TailCall(ct, tc) = ts.GetCopy().TailCall(ct, tc) |> ignore + member ts.GetAwaiter() = ts.GetCopy().GetAwaiter() [] module Async2Code = @@ -209,7 +208,7 @@ module Async2Implementation = code.Invoke(&sm)) let inline yieldOnBindLimit () = - Async2Code<_, _>(fun sm -> + Async2Code(fun sm -> if Trampoline.Current.IncrementBindCount() then let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) @@ -220,7 +219,41 @@ module Async2Implementation = else true) - type CancellableAwaiter<'t, 'a when Awaiter<'a, 't>> = CancellationToken -> 'a + let inline bindDynamic (sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) = + if Awaiter.isCompleted awaiter then + (Awaiter.getResult awaiter |> continuation).Invoke(&sm) + else + let resumptionFunc = + Async2ResumptionFunc(fun sm -> + let result = ExceptionCache.GetResultOrThrow awaiter + (continuation result).Invoke(&sm)) + + sm.ResumptionDynamicInfo.ResumptionFunc <- resumptionFunc + sm.ResumptionDynamicInfo.ResumptionData <- Awaiting awaiter + false + + let inline bindAwaiter (awaiter, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = + Async2Code(fun sm -> + if __useResumableCode then + if Awaiter.isCompleted awaiter then + continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) + else + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + + if __stack_yield_fin then + continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) + else + let mutable __stack_awaiter = awaiter + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&__stack_awaiter, &sm) + false + else + bindDynamic (&sm, awaiter, continuation)) + + [] + let inline bindCancellable + ([] cancellable, [] continuation: 'U -> Async2Code<'Data, 'T>) + : Async2Code<'Data, 'T> = + Async2Code<'Data, 'T>(fun sm -> bindAwaiter(cancellable sm.Data.CancellationToken, continuation).Invoke(&sm)) type Async2Builder() = @@ -264,81 +297,6 @@ module Async2Implementation = member inline _.For(sequence: seq<'T>, [] body: 'T -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) - static member inline BindDynamic - (sm: byref>, awaiter, [] continuation: _ -> Async2Code<_, _>) - = - if Awaiter.isCompleted awaiter then - (Awaiter.getResult awaiter |> continuation).Invoke(&sm) - else - let resumptionFunc = - Async2ResumptionFunc(fun sm -> - let result = ExceptionCache.GetResultOrThrow awaiter - (continuation result).Invoke(&sm)) - - sm.ResumptionDynamicInfo.ResumptionFunc <- resumptionFunc - sm.ResumptionDynamicInfo.ResumptionData <- Awaiting awaiter - false - - member inline _.BindAwaiter - (awaiter: Awaiter<_, _>, [] continuation: 'U -> Async2Code<'Data, 'T>) - : Async2Code<'Data, 'T> = - Async2Code(fun sm -> - if __useResumableCode then - if Awaiter.isCompleted awaiter then - continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) - else - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - - if __stack_yield_fin then - continuation(ExceptionCache.GetResultOrThrow awaiter).Invoke(&sm) - else - let mutable __stack_awaiter = awaiter - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&__stack_awaiter, &sm) - false - else - Async2Builder.BindDynamic(&sm, awaiter, continuation)) - - member inline this.BindCancellable - ([] binding: CancellableAwaiter<'U, 'Awaiter>, [] continuation: 'U -> Async2Code<'Data, 'T>) - : Async2Code<'Data, 'T> = - Async2Code(fun sm -> this.BindAwaiter(binding sm.Data.CancellationToken, continuation).Invoke(&sm)) - - member inline this.Bind(code: Async2<'U>, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = - Async2Code(fun sm -> this.BindCancellable((fun ct -> code.StartImmediate(ct).Task.GetAwaiter()), continuation).Invoke(&sm)) - - member inline this.Bind(awaiter, [] continuation) = this.BindAwaiter(awaiter, continuation) - - member inline this.Bind(cancellable, [] continuation) = - this.BindCancellable(cancellable, continuation) - - member inline this.ReturnFrom(code: Async2<'T>) : Async2Code<'T, 'T> = this.Bind(code, this.Return) - - member inline this.ReturnFrom(awaiter) = this.BindAwaiter(awaiter, this.Return) - - member inline this.ReturnFrom(cancellable) = - this.BindCancellable(cancellable, this.Return) - - member inline this.ReturnFromFinal(code: Async2<'T>) = - Async2Code(fun sm -> - let __stack_ct = sm.Data.CancellationToken - - match sm.Data.TailCallSource with - | ValueNone -> - // This is the start of a tail call chain. we need to return here when the entire chain is done. - let __stack_tcs = TaskCompletionSource<_>() - code.TailCall(__stack_ct, ValueSome __stack_tcs) - this.BindAwaiter(__stack_tcs.Task.GetAwaiter(), this.Return).Invoke(&sm) - | ValueSome tcs -> - // We are already in a tail call chain. - Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome tcs)) - false // Return false to abandon this state machine and continue on the next one. - ) - - member inline this.ReturnFromFinal(awaiter) : Async2Code<'T, 'T> = this.BindAwaiter(awaiter, this.Return) - - member inline this.ReturnFromFinal(cancellable) : Async2Code<'T, 'T> = - this.BindCancellable(cancellable, this.Return) - static member inline RunDynamic(code: Async2Code<'T, 'T>) : Async2<'T> = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) @@ -394,7 +352,7 @@ module Async2Implementation = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2ImplDynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo ())) + Async2Dynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo ())) member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then @@ -430,39 +388,72 @@ module Async2Implementation = (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine state)) - (AfterCode<_, _>(fun sm -> Async2Impl<_, _>(StateMachine = sm) :> Async2<'T>)) + (AfterCode<_, _>(fun sm -> Async2<_, _>(StateMachine = sm) :> Async2<'T>)) else Async2Builder.RunDynamic(code) - member inline _.Source(code: Async2<_>) = code +open Async2Implementation [] -module Async2AutoOpens = - open Async2Implementation +module LowPriority = + type Async2Builder with + [] + member inline this.Bind(awaitable, [] continuation) = + bindAwaiter (Awaitable.getAwaiter awaitable, continuation) - let async2 = Async2Builder() + [] + member inline this.ReturnFrom(awaitable) = this.Bind(awaitable, this.Return) -[] -module Async2LowPriority = - open Async2Implementation + [] + member inline this.ReturnFromFinal(awaitable) = this.ReturnFrom(awaitable) +[] +module MediumPriority = type Async2Builder with - member inline _.Source(awaitable: Awaitable<_, _, _>) = awaitable.GetAwaiter() + member inline this.Bind(expr: Async<_>, [] continuation) = + bindCancellable ((fun ct -> Async.StartAsTask(expr, cancellationToken = ct).GetAwaiter()), continuation) + + member inline this.Bind(task: Task, [] continuation) = + bindAwaiter (task.ConfigureAwait(false).GetAwaiter(), continuation) - member inline _.Source(items: _ seq) : _ seq = upcast items + member inline this.Bind(task: Task<_>, [] continuation) = + bindAwaiter (task.ConfigureAwait(false).GetAwaiter(), continuation) + + member inline this.ReturnFrom(task: Task) = this.Bind(task, this.Return) + member inline this.ReturnFrom(task: Task<_>) = this.Bind(task, this.Return) + member inline this.ReturnFrom(expr: Async<_>) = this.Bind(expr, this.Return) + member inline this.ReturnFromFinal(task: Task) = this.ReturnFrom(task) + member inline this.ReturnFromFinal(task: Task<_>) = this.ReturnFrom(task) + member inline this.ReturnFromFinal(expr: Async<_>) = this.ReturnFrom(expr) [] -module Async2MediumPriority = - open Async2Implementation +module HighPriority = type Async2Builder with - member inline _.Source(task: Task) = task.ConfigureAwait(false).GetAwaiter() - member inline _.Source(task: Task<_>) = task.ConfigureAwait(false).GetAwaiter() + member inline this.Bind(code: Async2<'U>, [] continuation) : Async2Code<'Data, 'T> = + bindCancellable ((fun ct -> code.StartImmediate(ct).GetAwaiter()), continuation) - member inline this.Source(expr: Async<'T>) : CancellableAwaiter<_, _> = - fun ct -> Async.StartAsTask(expr, cancellationToken = ct).GetAwaiter() + member inline this.ReturnFrom(code: Async2<'T>) : Async2Code<'T, 'T> = this.Bind(code, this.Return) -open Async2Implementation + member inline this.ReturnFromFinal(code: Async2<'T>) = + Async2Code(fun sm -> + match sm.Data.TailCallSource with + | ValueNone -> + // This is the start of a tail call chain. we need to return here when the entire chain is done. + let __stack_tcs = TaskCompletionSource<_>() + code.TailCall(sm.Data.CancellationToken, ValueSome __stack_tcs) + this.Bind(__stack_tcs.Task, this.Return).Invoke(&sm) + | ValueSome tcs -> + // We are already in a tail call chain. + let __stack_ct = sm.Data.CancellationToken + Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome tcs)) + false // Return false to abandon this state machine and continue on the next one. + ) + +[] +module Async2AutoOpens = + + let async2 = Async2Builder() module Async2 = From a2d257554d5f999cc73eb9480dfd38de7bc611c7 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 26 Sep 2025 10:51:10 +0200 Subject: [PATCH 39/48] temp bsl --- ...iler.Service.SurfaceArea.netstandard20.bsl | 100 +++++++++--------- 1 file changed, 51 insertions(+), 49 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index f956b885e6..b4b67f1904 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12436,16 +12436,8 @@ Internal.Utilities.Library.Async2: T RunImmediate[T](Internal.Utilities.Library. Internal.Utilities.Library.Async2: Void Start[a](Internal.Utilities.Library.Async2`1[a], Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) Internal.Utilities.Library.Async2AutoOpens: Async2Builder async2 Internal.Utilities.Library.Async2AutoOpens: Async2Builder get_async2() -Internal.Utilities.Library.Async2Implementation+Async2Builder: Boolean BindDynamic$W[t,a1,a2,a3](Microsoft.FSharp.Core.FSharpFunc`2[a1,a2], Microsoft.FSharp.Core.FSharpFunc`2[a1,System.Boolean], Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]] ByRef, a1, Microsoft.FSharp.Core.FSharpFunc`2[a2,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t],a3]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Boolean BindDynamic[t,a1,a2,a3](Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]] ByRef, a1, Microsoft.FSharp.Core.FSharpFunc`2[a2,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[t],a3]]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[T] RunDynamic[T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[T] Run[T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Internal.Utilities.Library.Async2`1[a] Source[a](Internal.Utilities.Library.Async2`1[a]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindAwaiter$W[s,U,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[s,U], Microsoft.FSharp.Core.FSharpFunc`2[s,System.Boolean], s, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindAwaiter[s,U,Data,T](s, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindCancellable$W[U,Awaiter,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,U], Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Awaiter], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] BindCancellable[U,Awaiter,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,Awaiter], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] Bind[U,Data,T](Internal.Utilities.Library.Async2`1[U], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] For[T,TOverall](System.Collections.Generic.IEnumerable`1[T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit]]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] While[TOverall](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.Boolean], Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],Microsoft.FSharp.Core.Unit] Zero[TOverall]() @@ -12454,22 +12446,14 @@ Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp. Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] TryFinally[TOverall,T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] TryWith[TOverall,T](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T], Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]]) Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T] Using[Resource,TOverall,T](Resource, Microsoft.FSharp.Core.FSharpFunc`2[Resource,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[TOverall],T]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal$W[T,b](Microsoft.FSharp.Core.FSharpFunc`2[b,T], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,b]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal$W[c,T](Microsoft.FSharp.Core.FSharpFunc`2[c,T], Microsoft.FSharp.Core.FSharpFunc`2[c,System.Boolean], c) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal[T,b](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,b]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFromFinal[c,T](c) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] ReturnFrom[T](Internal.Utilities.Library.Async2`1[T]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],a4] Return[T,a4](T) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],d] ReturnFromFinal[T,d](Internal.Utilities.Library.Async2`1[T]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[e],g] ReturnFrom$W[e,f,g](Microsoft.FSharp.Core.FSharpFunc`2[f,e], Microsoft.FSharp.Core.FSharpFunc`2[f,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,f]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[e],g] ReturnFrom[e,f,g](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,f]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[i],j] ReturnFrom$W[h,i,j](Microsoft.FSharp.Core.FSharpFunc`2[h,i], Microsoft.FSharp.Core.FSharpFunc`2[h,System.Boolean], h) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[i],j] ReturnFrom[h,i,j](h) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n] Bind$W[k,l,m,n](Microsoft.FSharp.Core.FSharpFunc`2[l,k], Microsoft.FSharp.Core.FSharpFunc`2[l,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,l], Microsoft.FSharp.Core.FSharpFunc`2[k,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n] Bind[k,l,m,n](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,l], Microsoft.FSharp.Core.FSharpFunc`2[k,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[m],n]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r] Bind$W[o,p,q,r](Microsoft.FSharp.Core.FSharpFunc`2[o,p], Microsoft.FSharp.Core.FSharpFunc`2[o,System.Boolean], o, Microsoft.FSharp.Core.FSharpFunc`2[p,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r]]) -Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r] Bind[o,p,q,r](o, Microsoft.FSharp.Core.FSharpFunc`2[p,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[q],r]]) +Internal.Utilities.Library.Async2Implementation+Async2Builder: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],a] Return[T,a](T) Internal.Utilities.Library.Async2Implementation+Async2Builder: Void .ctor() +Internal.Utilities.Library.Async2Implementation+Async2Code: Boolean bindDynamic$W[a,b,c,d](Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a]] ByRef, b, Microsoft.FSharp.Core.FSharpFunc`2[c,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],d]]) +Internal.Utilities.Library.Async2Implementation+Async2Code: Boolean bindDynamic[a,b,c,d](Microsoft.FSharp.Core.CompilerServices.ResumableStateMachine`1[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a]] ByRef, b, Microsoft.FSharp.Core.FSharpFunc`2[c,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],d]]) +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] bindAwaiter$W[a,U,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[a,U], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] bindAwaiter[a,U,Data,T](a, Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] bindCancellable$W[a,U,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[a,U], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,a], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] bindCancellable[a,U,Data,T](Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,a], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] yieldOnBindLimit[a,b]() Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] filterCancellation[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]], System.Exception) Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] throwIfCancellationRequested[a,b,c](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]) @@ -12483,22 +12467,26 @@ Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Microsoft.FShar Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1[t] MethodBuilder Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Threading.CancellationToken CancellationToken Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: t Result -Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) -Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,m]) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(Async2Impl`2) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(Async2Impl`2, System.Collections.IEqualityComparer) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(System.Object) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Int32 GetHashCode() -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Int32 GetHashCode(System.Collections.IEqualityComparer) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) -Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m]: m StateMachine -Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted$W[Awaiter](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,System.Boolean], Awaiter) -Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted[Awaiter](Awaiter) -Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult$W[Awaiter,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Awaiter,TResult], Awaiter) -Internal.Utilities.Library.Async2Implementation+Awaiter: TResult getResult[Awaiter,TResult](Awaiter) -Internal.Utilities.Library.Async2Implementation+Awaiter: Void onCompleted[Awaiter](Awaiter, System.Action) -Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted[Awaiter](Awaiter, System.Action) +Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Internal.Utilities.Library.Async2`1[t] GetCopy() +Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,m]) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(Async2`2) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(Async2`2, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(System.Object) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Int32 GetHashCode() +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Int32 GetHashCode(System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: m StateMachine +Internal.Utilities.Library.Async2Implementation+Awaitable: b getAwaiter$W[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], a) +Internal.Utilities.Library.Async2Implementation+Awaitable: b getAwaiter[a,b,c](a) +Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) +Internal.Utilities.Library.Async2Implementation+Awaiter: Boolean isCompleted[a,b](a) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void onCompleted$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a, System.Action) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void onCompleted[a,b](a, System.Action) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a, System.Action) +Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted[a,b](a, System.Action) +Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) +Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult[a,b](a) Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion Item Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion get_Item() Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce: DynamicState Item @@ -12551,7 +12539,7 @@ Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.C Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.CompilerServices.ConditionalWeakTable`2[System.Exception,System.Runtime.ExceptionServices.ExceptionDispatchInfo] store Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.ExceptionServices.ExceptionDispatchInfo CaptureOrRetrieve(System.Exception) Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) -Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], a) +Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean IncrementBindCount() Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref @@ -12563,19 +12551,14 @@ Internal.Utilities.Library.Async2Implementation+Trampoline: Void Set(System.Acti Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Builder Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Code Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Data`1[t] -Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2ImplDynamic`2[t,m] -Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Impl`2[t,m] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2`2[t,m] +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaitable Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaiter Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+DynamicState Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+ExceptionCache Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Trampoline Internal.Utilities.Library.Async2Implementation: Void failIfNot(Boolean, System.String) -Internal.Utilities.Library.Async2LowPriority: System.Collections.Generic.IEnumerable`1[a] Async2Builder.Source[a](Async2Builder, System.Collections.Generic.IEnumerable`1[a]) -Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source$W[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a) -Internal.Utilities.Library.Async2LowPriority: b Async2Builder.Source[a,b,c](Async2Builder, a) -Internal.Utilities.Library.Async2MediumPriority: Microsoft.FSharp.Core.FSharpFunc`2[System.Threading.CancellationToken,System.Runtime.CompilerServices.TaskAwaiter`1[T]] Async2Builder.Source[T](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[T]) -Internal.Utilities.Library.Async2MediumPriority: System.Runtime.CompilerServices.TaskAwaiter Async2Builder.Source(Async2Builder, System.Threading.Tasks.Task) -Internal.Utilities.Library.Async2MediumPriority: System.Runtime.CompilerServices.TaskAwaiter`1[a] Async2Builder.Source[a](Async2Builder, System.Threading.Tasks.Task`1[a]) Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) @@ -12596,6 +12579,10 @@ Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Co Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] GetDictionary() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: T[] GetArray() Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T[]]) +Internal.Utilities.Library.HighPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T] Async2Builder.Bind[U,Data,T](Async2Builder, Internal.Utilities.Library.Async2`1[U], Microsoft.FSharp.Core.FSharpFunc`2[U,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Data],T]]) +Internal.Utilities.Library.HighPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],T] Async2Builder.ReturnFrom[T](Async2Builder, Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.HighPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[T],a] Async2Builder.ReturnFromFinal[T,a](Async2Builder, Internal.Utilities.Library.Async2`1[T]) +Internal.Utilities.Library.IAsync2Invocation`1[t]: System.Runtime.CompilerServices.TaskAwaiter`1[t] GetAwaiter() Internal.Utilities.Library.IAsync2Invocation`1[t]: System.Threading.Tasks.Task`1[t] Task Internal.Utilities.Library.IAsync2Invocation`1[t]: System.Threading.Tasks.Task`1[t] get_Task() Internal.Utilities.Library.InterruptibleLazy: T force[T](Internal.Utilities.Library.InterruptibleLazy`1[T]) @@ -12605,4 +12592,19 @@ Internal.Utilities.Library.InterruptibleLazy`1[T]: Internal.Utilities.Library.In Internal.Utilities.Library.InterruptibleLazy`1[T]: T Force() Internal.Utilities.Library.InterruptibleLazy`1[T]: T Value Internal.Utilities.Library.InterruptibleLazy`1[T]: T get_Value() -Internal.Utilities.Library.InterruptibleLazy`1[T]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) \ No newline at end of file +Internal.Utilities.Library.InterruptibleLazy`1[T]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[c],d] Async2Builder.ReturnFrom$W[a,b,c,d](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[c],d] Async2Builder.ReturnFromFinal$W[a,b,c,d](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[c],d] Async2Builder.ReturnFromFinal[a,b,c,d](Async2Builder, a) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[c],d] Async2Builder.ReturnFrom[a,b,c,d](Async2Builder, a) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[d],e] Async2Builder.Bind$W[a,b,c,d,e](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], Async2Builder, a, Microsoft.FSharp.Core.FSharpFunc`2[c,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[d],e]]) +Internal.Utilities.Library.LowPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[d],e] Async2Builder.Bind[a,b,c,d,e](Async2Builder, a, Microsoft.FSharp.Core.FSharpFunc`2[c,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[d],e]]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Microsoft.FSharp.Core.Unit],a] Async2Builder.ReturnFromFinal[a](Async2Builder, System.Threading.Tasks.Task) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[Microsoft.FSharp.Core.Unit],a] Async2Builder.ReturnFrom[a](Async2Builder, System.Threading.Tasks.Task) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] Async2Builder.Bind[a,b](Async2Builder, System.Threading.Tasks.Task, Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] Async2Builder.ReturnFromFinal[a,b](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[a]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] Async2Builder.ReturnFromFinal[a,b](Async2Builder, System.Threading.Tasks.Task`1[a]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] Async2Builder.ReturnFrom[a,b](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[a]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] Async2Builder.ReturnFrom[a,b](Async2Builder, System.Threading.Tasks.Task`1[a]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[b],c] Async2Builder.Bind[a,b,c](Async2Builder, Microsoft.FSharp.Control.FSharpAsync`1[a], Microsoft.FSharp.Core.FSharpFunc`2[a,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[b],c]]) +Internal.Utilities.Library.MediumPriority: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[b],c] Async2Builder.Bind[a,b,c](Async2Builder, System.Threading.Tasks.Task`1[a], Microsoft.FSharp.Core.FSharpFunc`2[a,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[b],c]]) \ No newline at end of file From dfc6b564c8ea41b3ecca75359fc5354641a2ae66 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 28 Sep 2025 22:03:49 +0200 Subject: [PATCH 40/48] better sort out bound vs immediate start --- src/Compiler/Utilities/Async2.fs | 126 +++++++++--------- ...iler.Service.SurfaceArea.netstandard20.bsl | 23 ++-- 2 files changed, 79 insertions(+), 70 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 7f68454b96..d8f152dd78 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -4,6 +4,7 @@ open System open System.Threading open System.Threading.Tasks open System.Runtime.CompilerServices +open System.Runtime.ExceptionServices open FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.CompilerServices @@ -15,17 +16,12 @@ type IAsync2Invocation<'t> = and Async2<'t> = abstract StartImmediate: CancellationToken -> IAsync2Invocation<'t> + abstract StartBound: CancellationToken -> TaskAwaiter<'t> abstract TailCall: CancellationToken * TaskCompletionSource<'t> voption -> unit abstract GetAwaiter: unit -> TaskAwaiter<'t> module Async2Implementation = - open System.Runtime.ExceptionServices - - let failIfNot condition message = - if not condition then - failwith message - /// A structure that looks like an Awaiter type Awaiter<'Awaiter, 'TResult when 'Awaiter :> ICriticalNotifyCompletion @@ -54,22 +50,30 @@ module Async2Implementation = | Bounce of DynamicState | Immediate of DynamicState + module BindContext = + let bindCount = new ThreadLocal() + + [] + let bindLimit = 100 + + let IncrementBindCount () = + bindCount.Value <- bindCount.Value + 1 + bindCount.Value >= bindLimit + + let Reset () = bindCount.Value <- 0 + type Trampoline private () = let ownerThreadId = Thread.CurrentThread.ManagedThreadId static let holder = new ThreadLocal<_>(fun () -> Trampoline()) - [] - static let bindLimit = 100 - - let mutable bindCount = 0 - let mutable pending: Action voption = ValueNone let mutable running = false let start (action: Action) = try + BindContext.Reset() running <- true action.Invoke() @@ -81,10 +85,10 @@ module Async2Implementation = running <- false let set action = - failIfNot (Thread.CurrentThread.ManagedThreadId = ownerThreadId) "Trampoline used from wrong thread" - failIfNot pending.IsNone "Trampoline used while already pending" + assert (Thread.CurrentThread.ManagedThreadId = ownerThreadId) // "Trampoline used from wrong thread" + assert pending.IsNone // "Trampoline set while already pending" - bindCount <- 0 + BindContext.Reset() if running then pending <- ValueSome action @@ -97,14 +101,6 @@ module Async2Implementation = member this.Ref: ICriticalNotifyCompletion ref = ref this - member this.Set action = set action - - member this.Reset() = bindCount <- 0 - - member _.IncrementBindCount() = - bindCount <- bindCount + 1 - bindCount >= bindLimit - static member Current = holder.Value module ExceptionCache = @@ -148,6 +144,9 @@ module Async2Implementation = [] val mutable CancellationToken: CancellationToken + [] + val mutable IsBound: bool + type Async2StateMachine<'TOverall> = ResumableStateMachine> type IAsync2StateMachine<'TOverall> = IResumableStateMachine> type Async2ResumptionFunc<'TOverall> = ResumptionFunc> @@ -160,11 +159,12 @@ module Async2Implementation = [] val mutable StateMachine: 'm - member ts.Start(ct, tc) = + member ts.Start(ct, tailCallSource, isBound) = let mutable copy = ts let mutable data = Async2Data() data.CancellationToken <- ct - data.TailCallSource <- tc + data.TailCallSource <- tailCallSource + data.IsBound <- isBound data.MethodBuilder <- AsyncTaskMethodBuilder<'t>.Create() copy.StateMachine.Data <- data copy.StateMachine.Data.MethodBuilder.Start(©.StateMachine) @@ -177,29 +177,39 @@ module Async2Implementation = ts.StateMachine.Data.MethodBuilder.Task.GetAwaiter() interface Async2<'t> with - member ts.StartImmediate ct = ts.Start(ct, ValueNone) - member ts.TailCall(ct, tc) = ts.Start(ct, tc) |> ignore + member ts.StartImmediate ct = ts.Start(ct, ValueNone, false) + + member ts.StartBound ct = + ts.Start(ct, ValueNone, true).GetAwaiter() + + member ts.TailCall(ct, tc) = ts.Start(ct, tc, true) |> ignore member ts.GetAwaiter() = - ts.Start(CancellationToken.None, ValueNone).GetAwaiter() + ts.Start(CancellationToken.None, ValueNone, true).GetAwaiter() - type Async2Dynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: unit -> 'm) = - member ts.GetCopy() = - Async2(StateMachine = getCopy ()) :> Async2<_> + type Async2Dynamic<'t, 'm when 'm :> IAsyncStateMachine and 'm :> IAsync2StateMachine<'t>>(getCopy: bool -> 'm) = + member ts.GetCopy isBound = + Async2(StateMachine = getCopy isBound) :> Async2<_> interface Async2<'t> with - member ts.StartImmediate ct = ts.GetCopy().StartImmediate(ct) - member ts.TailCall(ct, tc) = ts.GetCopy().TailCall(ct, tc) |> ignore - member ts.GetAwaiter() = ts.GetCopy().GetAwaiter() + member ts.StartImmediate ct = ts.GetCopy(false).StartImmediate(ct) + member ts.StartBound ct = ts.GetCopy(true).StartBound(ct) + + member ts.TailCall(ct, tc) = + ts.GetCopy(true).TailCall(ct, tc) |> ignore + + member ts.GetAwaiter() = ts.GetCopy(true).GetAwaiter() [] module Async2Code = let inline filterCancellation ([] catch: exn -> Async2Code<_, _>) (exn: exn) = Async2Code(fun sm -> - let ct = sm.Data.CancellationToken - match exn with - | :? OperationCanceledException as oce when ct.IsCancellationRequested || oce.CancellationToken = ct -> raise exn + | :? OperationCanceledException as oce when + sm.Data.CancellationToken.IsCancellationRequested + || oce.CancellationToken = sm.Data.CancellationToken + -> + raise exn | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: Async2Code<_, _>) = @@ -209,7 +219,7 @@ module Async2Implementation = let inline yieldOnBindLimit () = Async2Code(fun sm -> - if Trampoline.Current.IncrementBindCount() then + if BindContext.IncrementBindCount() then let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) if not __stack_yield_fin then @@ -249,7 +259,6 @@ module Async2Implementation = else bindDynamic (&sm, awaiter, continuation)) - [] let inline bindCancellable ([] cancellable, [] continuation: 'U -> Async2Code<'Data, 'T>) : Async2Code<'Data, 'T> = @@ -301,13 +310,15 @@ module Async2Implementation = let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke &sm) let maybeBounce state = - if Trampoline.Current.IncrementBindCount() then + if BindContext.IncrementBindCount() then Bounce state else Immediate state - let resumptionInfo () = - { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, ResumptionData = (maybeBounce Running)) with + let resumptionInfo isBound = + let initialState = if isBound then maybeBounce Running else Immediate Running + + { new Async2ResumptionDynamicInfo<'T>(initialResumptionFunc, ResumptionData = initialState) with member info.MoveNext(sm) = let getCurrent () = @@ -352,7 +363,7 @@ module Async2Implementation = sm.Data.MethodBuilder.SetStateMachine(state) } - Async2Dynamic<_, _>(fun () -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo ())) + Async2Dynamic<_, _>(fun isBound -> Async2StateMachine(ResumptionDynamicInfo = resumptionInfo isBound)) member inline _.Run(code: Async2Code<'T, 'T>) : Async2<'T> = if __useResumableCode then @@ -362,7 +373,7 @@ module Async2Implementation = __resumeAt sm.ResumptionPoint let mutable error = ValueNone - let __stack_go1 = yieldOnBindLimit().Invoke(&sm) + let __stack_go1 = not sm.Data.IsBound || yieldOnBindLimit().Invoke(&sm) if __stack_go1 then try @@ -431,7 +442,7 @@ module HighPriority = type Async2Builder with member inline this.Bind(code: Async2<'U>, [] continuation) : Async2Code<'Data, 'T> = - bindCancellable ((fun ct -> code.StartImmediate(ct).GetAwaiter()), continuation) + bindCancellable (code.StartBound, continuation) member inline this.ReturnFrom(code: Async2<'T>) : Async2Code<'T, 'T> = this.Bind(code, this.Return) @@ -446,7 +457,7 @@ module HighPriority = | ValueSome tcs -> // We are already in a tail call chain. let __stack_ct = sm.Data.CancellationToken - Trampoline.Current.Set(fun () -> code.TailCall(__stack_ct, ValueSome tcs)) + code.TailCall(__stack_ct, ValueSome tcs) false // Return false to abandon this state machine and continue on the next one. ) @@ -459,12 +470,8 @@ module Async2 = let CheckAndThrowToken = AsyncLocal() - let inline start (code: Async2<_>) ct = + let inline start ct (code: Async2<_>) = CheckAndThrowToken.Value <- ct - // Only bound computations can participate in trampolining, otherwise we risk sync over async deadlocks. - // To prevent this, we reset the bind count here. - // This computation will not initially bounce, even if it is nested inside another async2 computation. - Trampoline.Current.Reset() code.StartImmediate ct let run ct (code: Async2<'t>) = @@ -473,25 +480,22 @@ module Async2 = isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then - start code ct |> _.Task.GetAwaiter().GetResult() + start ct code |> _.GetAwaiter().GetResult() else - Task.Run<'t>(fun () -> start code ct |> _.Task).GetAwaiter().GetResult() + Task.Run<'t>(fun () -> start ct code |> _.Task).GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code - let startAsTaskWithoutCancellation code = start code CancellationToken.None - - let startAsTask ct code = start code ct |> _.Task - - let queue ct code = Task.Run(fun () -> start code ct) + let startAsTaskWithoutCancellation code = + start CancellationToken.None code |> _.Task let queueTask ct code = - Task.Run<'t>(fun () -> startAsTask ct code) + Task.Run<'t>(fun () -> start ct code |> _.Task) let toAsync (code: Async2<'t>) = async { let! ct = Async.CancellationToken - let task = startAsTask ct code + let task = start ct code |> _.Task return! Async.AwaitTask task } @@ -517,7 +521,7 @@ type Async2 = static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.startAsTask ct computation + Async2.start ct computation |> _.Task static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None @@ -567,7 +571,7 @@ type Async2 = static member TryCancelled(computation: Async2<'T>, compensation) = async2 { let! ct = Async2.CancellationToken - let task = computation |> Async2.startAsTask ct + let task = computation |> Async2.start ct |> _.Task try return! task diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index b4b67f1904..943a54d367 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12457,25 +12457,30 @@ Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Cor Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] yieldOnBindLimit[a,b]() Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] filterCancellation[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]], System.Exception) Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] throwIfCancellationRequested[a,b,c](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]) +Internal.Utilities.Library.Async2Implementation+Async2Context: Boolean IncrementBindCount() +Internal.Utilities.Library.Async2Implementation+Async2Context: Int32 bindLimit +Internal.Utilities.Library.Async2Implementation+Async2Context: System.Threading.ThreadLocal`1[System.Int32] bindCount +Internal.Utilities.Library.Async2Implementation+Async2Context: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1, System.Collections.IEqualityComparer) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(System.Object) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean IsBound Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Int32 GetHashCode() Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Int32 GetHashCode(System.Collections.IEqualityComparer) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]] TailCallSource Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1[t] MethodBuilder Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: System.Threading.CancellationToken CancellationToken Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: t Result -Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Internal.Utilities.Library.Async2`1[t] GetCopy() -Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,m]) +Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Internal.Utilities.Library.Async2`1[t] GetCopy(Boolean) +Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m]: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[System.Boolean,m]) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(Async2`2) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(Async2`2, System.Collections.IEqualityComparer) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(System.Object) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Boolean Equals(System.Object, System.Collections.IEqualityComparer) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Int32 GetHashCode() Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Int32 GetHashCode(System.Collections.IEqualityComparer) -Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) +Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: Internal.Utilities.Library.IAsync2Invocation`1[t] Start(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]], Boolean) Internal.Utilities.Library.Async2Implementation+Async2`2[t,m]: m StateMachine Internal.Utilities.Library.Async2Implementation+Awaitable: b getAwaiter$W[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[b,c], Microsoft.FSharp.Core.FSharpFunc`2[b,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+Awaitable: b getAwaiter[a,b,c](a) @@ -12541,15 +12546,16 @@ Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.E Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) -Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean IncrementBindCount() +Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean Running +Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean get_Running() Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] get_Ref() Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline Current Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline get_Current() -Internal.Utilities.Library.Async2Implementation+Trampoline: Void Reset() Internal.Utilities.Library.Async2Implementation+Trampoline: Void Set(System.Action) Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Builder Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Code +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Context Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Data`1[t] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2`2[t,m] @@ -12562,18 +12568,17 @@ Internal.Utilities.Library.Async2Implementation: Void failIfNot(Boolean, System. Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) -Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] startAsTaskWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) -Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] start[a](Internal.Utilities.Library.Async2`1[a], System.Threading.CancellationToken) +Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] start[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: Microsoft.FSharp.Control.FSharpAsync`1[t] toAsync[t](Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] CheckAndThrowToken Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] get_CheckAndThrowToken() -Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[Internal.Utilities.Library.IAsync2Invocation`1[a]] queue[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) -Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] startAsTask[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] startAsTaskWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] queueTask[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2Module: a runWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: t run[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2`1[t]: Internal.Utilities.Library.IAsync2Invocation`1[t] StartImmediate(System.Threading.CancellationToken) Internal.Utilities.Library.Async2`1[t]: System.Runtime.CompilerServices.TaskAwaiter`1[t] GetAwaiter() +Internal.Utilities.Library.Async2`1[t]: System.Runtime.CompilerServices.TaskAwaiter`1[t] StartBound(System.Threading.CancellationToken) Internal.Utilities.Library.Async2`1[t]: Void TailCall(System.Threading.CancellationToken, Microsoft.FSharp.Core.FSharpValueOption`1[System.Threading.Tasks.TaskCompletionSource`1[t]]) Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] CreateDictionary(T[]) Internal.Utilities.Library.DelayInitArrayMap`3[T,TDictKey,TDictValue]: System.Collections.Generic.IDictionary`2[TDictKey,TDictValue] GetDictionary() From a35f98b808ed999c6baa542df3e94f5c58d12dfe Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 30 Sep 2025 11:43:57 +0200 Subject: [PATCH 41/48] automatically prevent sync over async --- src/Compiler/Utilities/Async2.fs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index d8f152dd78..03c048c9a0 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -52,6 +52,8 @@ module Async2Implementation = module BindContext = let bindCount = new ThreadLocal() + // Used to prevent sync over async deadlocks. + let started = new AsyncLocal() [] let bindLimit = 100 @@ -193,6 +195,7 @@ module Async2Implementation = interface Async2<'t> with member ts.StartImmediate ct = ts.GetCopy(false).StartImmediate(ct) + member ts.StartBound ct = ts.GetCopy(true).StartBound(ct) member ts.TailCall(ct, tc) = @@ -371,6 +374,7 @@ module Async2Implementation = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint + let mutable error = ValueNone let __stack_go1 = not sm.Data.IsBound || yieldOnBindLimit().Invoke(&sm) @@ -471,13 +475,21 @@ module Async2 = let CheckAndThrowToken = AsyncLocal() let inline start ct (code: Async2<_>) = - CheckAndThrowToken.Value <- ct - code.StartImmediate ct + let oldCt = CheckAndThrowToken.Value + + try + BindContext.started.Value <- true + CheckAndThrowToken.Value <- ct + code.StartImmediate ct + finally + CheckAndThrowToken.Value <- oldCt + BindContext.started.Value <- false let run ct (code: Async2<'t>) = if - isNull SynchronizationContext.Current + not BindContext.started.Value // should this be an assert fail or even an exception instead? + && isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default then start ct code |> _.GetAwaiter().GetResult() From 9d6c6f3a558485465b42174736789cb187dd2a5e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 30 Sep 2025 13:37:07 +0200 Subject: [PATCH 42/48] more sync over async --- src/Compiler/Utilities/Async2.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 03c048c9a0..a7eaabfabb 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -498,16 +498,16 @@ module Async2 = let runWithoutCancellation code = run CancellationToken.None code - let startAsTaskWithoutCancellation code = - start CancellationToken.None code |> _.Task - let queueTask ct code = Task.Run<'t>(fun () -> start ct code |> _.Task) + let startAsTaskWithoutCancellation code = + queueTask CancellationToken.None code + let toAsync (code: Async2<'t>) = async { let! ct = Async.CancellationToken - let task = start ct code |> _.Task + let task = queueTask ct code return! Async.AwaitTask task } @@ -533,7 +533,7 @@ type Async2 = static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.start ct computation |> _.Task + Async2.queueTask ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None @@ -583,12 +583,12 @@ type Async2 = static member TryCancelled(computation: Async2<'T>, compensation) = async2 { let! ct = Async2.CancellationToken - let task = computation |> Async2.start ct |> _.Task + let invocation = Async2.start ct computation try - return! task + return! invocation finally - if task.IsCanceled then + if invocation.Task.IsCanceled then compensation () } From c325c57f7e7ce765d0849158fe4e6b4415f8340a Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 30 Sep 2025 14:08:42 +0200 Subject: [PATCH 43/48] wip --- src/Compiler/Utilities/Async2.fs | 48 +++++++++---------- ...iler.Service.SurfaceArea.netstandard20.bsl | 17 ++++--- 2 files changed, 32 insertions(+), 33 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index a7eaabfabb..8ea3013e80 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -476,38 +476,38 @@ module Async2 = let inline start ct (code: Async2<_>) = let oldCt = CheckAndThrowToken.Value + let oldStarted = BindContext.started.Value + + let immediate = + not oldStarted + && isNull SynchronizationContext.Current + && TaskScheduler.Current = TaskScheduler.Default try BindContext.started.Value <- true CheckAndThrowToken.Value <- ct - code.StartImmediate ct + if immediate then + code.StartImmediate ct |> _.Task + else + Task.Run<'t>(fun () -> code.StartImmediate ct |> _.Task) finally CheckAndThrowToken.Value <- oldCt - BindContext.started.Value <- false + BindContext.started.Value <- oldStarted - let run ct (code: Async2<'t>) = - - if - not BindContext.started.Value // should this be an assert fail or even an exception instead? - && isNull SynchronizationContext.Current - && TaskScheduler.Current = TaskScheduler.Default - then - start ct code |> _.GetAwaiter().GetResult() - else - Task.Run<'t>(fun () -> start ct code |> _.Task).GetAwaiter().GetResult() + let run ct (code: Async2<'t>) = start ct code |> _.GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code - let queueTask ct code = - Task.Run<'t>(fun () -> start ct code |> _.Task) + //let queueTask ct code = + // Task.Run<'t>(fun () -> start ct code) let startAsTaskWithoutCancellation code = - queueTask CancellationToken.None code + start CancellationToken.None code let toAsync (code: Async2<'t>) = async { let! ct = Async.CancellationToken - let task = queueTask ct code + let task = start ct code return! Async.AwaitTask task } @@ -529,11 +529,11 @@ type Async2 = static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None - Async2.queueTask ct computation |> ignore + Async2.start ct computation |> ignore static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.queueTask ct computation + Async2.start ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None @@ -554,7 +554,7 @@ type Async2 = lcts.Cancel() return raise exn } - |> Async2.queueTask lcts.Token + |> Async2.start lcts.Token } return! Task.WhenAll tasks @@ -583,25 +583,25 @@ type Async2 = static member TryCancelled(computation: Async2<'T>, compensation) = async2 { let! ct = Async2.CancellationToken - let invocation = Async2.start ct computation + let task = Async2.start ct computation try - return! invocation + return! task finally - if invocation.Task.IsCanceled then + if task.IsCanceled then compensation () } static member StartChild(computation: Async2<'T>) : Async2> = async2 { let! ct = Async2.CancellationToken - return async2 { return! computation |> Async2.queueTask ct } + return async2 { return! computation |> Async2.start ct } } static member StartChildAsTask(computation: Async2<'T>) : Async2> = async2 { let! ct = Async2.CancellationToken - let task = computation |> Async2.queueTask ct + let task = computation |> Async2.start ct return task } diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index a643b594da..98d2044768 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12422,10 +12422,6 @@ Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Cor Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b] yieldOnBindLimit[a,b]() Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] filterCancellation[a,b,c](Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]], System.Exception) Internal.Utilities.Library.Async2Implementation+Async2Code: Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],c] throwIfCancellationRequested[a,b,c](Microsoft.FSharp.Core.CompilerServices.ResumableCode`2[Internal.Utilities.Library.Async2Implementation+Async2Data`1[a],b]) -Internal.Utilities.Library.Async2Implementation+Async2Context: Boolean IncrementBindCount() -Internal.Utilities.Library.Async2Implementation+Async2Context: Int32 bindLimit -Internal.Utilities.Library.Async2Implementation+Async2Context: System.Threading.ThreadLocal`1[System.Int32] bindCount -Internal.Utilities.Library.Async2Implementation+Async2Context: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(Async2Data`1, System.Collections.IEqualityComparer) Internal.Utilities.Library.Async2Implementation+Async2Data`1[t]: Boolean Equals(System.Object) @@ -12457,6 +12453,13 @@ Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted$ Internal.Utilities.Library.Async2Implementation+Awaiter: Void unsafeOnCompleted[a,b](a, System.Action) Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult[a,b](a) +Internal.Utilities.Library.Async2Implementation+BindContext: Boolean IncrementBindCount() +Internal.Utilities.Library.Async2Implementation+BindContext: Int32 bindLimit +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.AsyncLocal`1[System.Boolean] get_started() +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.AsyncLocal`1[System.Boolean] started +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] bindCount +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() +Internal.Utilities.Library.Async2Implementation+BindContext: Void Reset() Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion Item Internal.Utilities.Library.Async2Implementation+DynamicState+Awaiting: System.Runtime.CompilerServices.ICriticalNotifyCompletion get_Item() Internal.Utilities.Library.Async2Implementation+DynamicState+Bounce: DynamicState Item @@ -12511,25 +12514,21 @@ Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.E Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) -Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean Running -Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean get_Running() Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] get_Ref() Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline Current Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline get_Current() -Internal.Utilities.Library.Async2Implementation+Trampoline: Void Set(System.Action) Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Builder Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Code -Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Context Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Data`1[t] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2Dynamic`2[t,m] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Async2`2[t,m] Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaitable Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Awaiter +Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+BindContext Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+DynamicState Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+ExceptionCache Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Async2Implementation+Trampoline -Internal.Utilities.Library.Async2Implementation: Void failIfNot(Boolean, System.String) Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) From 6f0fa7cd2c0e67350c20179feba0171391cc78f2 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 30 Sep 2025 15:39:13 +0200 Subject: [PATCH 44/48] temp bsl --- src/Compiler/Utilities/Async2.fs | 7 ++++--- .../FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl | 3 +-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 8ea3013e80..de2204fbd0 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -486,6 +486,7 @@ module Async2 = try BindContext.started.Value <- true CheckAndThrowToken.Value <- ct + if immediate then code.StartImmediate ct |> _.Task else @@ -494,15 +495,15 @@ module Async2 = CheckAndThrowToken.Value <- oldCt BindContext.started.Value <- oldStarted - let run ct (code: Async2<'t>) = start ct code |> _.GetAwaiter().GetResult() + let run ct (code: Async2<'t>) = + start ct code |> _.GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code //let queueTask ct code = // Task.Run<'t>(fun () -> start ct code) - let startAsTaskWithoutCancellation code = - start CancellationToken.None code + let startAsTaskWithoutCancellation code = start CancellationToken.None code let toAsync (code: Async2<'t>) = async { diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 98d2044768..92c9f61621 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12532,12 +12532,11 @@ Internal.Utilities.Library.Async2Implementation: Internal.Utilities.Library.Asyn Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] CancellationToken Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[System.Threading.CancellationToken] get_CancellationToken() Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.Async2`1[t] fromValue[t](t) -Internal.Utilities.Library.Async2Module: Internal.Utilities.Library.IAsync2Invocation`1[a] start[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: Microsoft.FSharp.Control.FSharpAsync`1[t] toAsync[t](Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] CheckAndThrowToken Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] get_CheckAndThrowToken() Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] startAsTaskWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) -Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] queueTask[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] start[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2Module: a runWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: t run[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2`1[t]: Internal.Utilities.Library.IAsync2Invocation`1[t] StartImmediate(System.Threading.CancellationToken) From f2ba059a93c43ee2771248e540c3731e9fb90e27 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 1 Oct 2025 14:37:05 +0200 Subject: [PATCH 45/48] better --- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 +- src/Compiler/Utilities/Async2.fs | 54 ++++++++++--------- ...iler.Service.SurfaceArea.netstandard20.bsl | 4 +- 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 0ac9bfd637..9fa521d035 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -952,12 +952,12 @@ type StackGuard(maxDepth: int, name: string) = StackGuardMetrics.countJump memberName $"{fileName}:{line}" - async { + async2 { do! Async.SwitchToNewThread() Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" return f () } - |> Async.RunImmediate + |> Async2.RunImmediate else f () finally diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index de2204fbd0..49f9014657 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -52,8 +52,6 @@ module Async2Implementation = module BindContext = let bindCount = new ThreadLocal() - // Used to prevent sync over async deadlocks. - let started = new AsyncLocal() [] let bindLimit = 100 @@ -103,6 +101,8 @@ module Async2Implementation = member this.Ref: ICriticalNotifyCompletion ref = ref this + member _.Running = running + static member Current = holder.Value module ExceptionCache = @@ -474,36 +474,40 @@ module Async2 = let CheckAndThrowToken = AsyncLocal() + let startInThreadPool ct (code: Async2<_>) = + Task.Run<'t>(fun () -> + CheckAndThrowToken.Value <- ct + code.StartImmediate ct |> _.Task) + let inline start ct (code: Async2<_>) = - let oldCt = CheckAndThrowToken.Value - let oldStarted = BindContext.started.Value let immediate = - not oldStarted + not Trampoline.Current.Running // prevent deadlock, TODO: better solution? && isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default - try - BindContext.started.Value <- true - CheckAndThrowToken.Value <- ct + if immediate then + let oldCt = CheckAndThrowToken.Value - if immediate then + try + CheckAndThrowToken.Value <- ct code.StartImmediate ct |> _.Task - else - Task.Run<'t>(fun () -> code.StartImmediate ct |> _.Task) - finally - CheckAndThrowToken.Value <- oldCt - BindContext.started.Value <- oldStarted + + finally + CheckAndThrowToken.Value <- oldCt + else + startInThreadPool ct code let run ct (code: Async2<'t>) = - start ct code |> _.GetAwaiter().GetResult() + startInThreadPool ct code |> _.GetAwaiter().GetResult() let runWithoutCancellation code = run CancellationToken.None code //let queueTask ct code = // Task.Run<'t>(fun () -> start ct code) - let startAsTaskWithoutCancellation code = start CancellationToken.None code + let startAsTaskWithoutCancellation code = + startInThreadPool CancellationToken.None code let toAsync (code: Async2<'t>) = async { @@ -530,15 +534,15 @@ type Async2 = static member Start(computation: Async2<_>, ?cancellationToken: CancellationToken) : unit = let ct = defaultArg cancellationToken CancellationToken.None - Async2.start ct computation |> ignore + Async2.startInThreadPool ct computation |> ignore static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.start ct computation + Async2.startInThreadPool ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None - Async2.run ct computation + Async2.start ct computation |> _.GetAwaiter().GetResult() static member Parallel(computations: Async2<_> seq) = async2 { @@ -555,7 +559,7 @@ type Async2 = lcts.Cancel() return raise exn } - |> Async2.start lcts.Token + |> Async2.startInThreadPool lcts.Token } return! Task.WhenAll tasks @@ -584,25 +588,25 @@ type Async2 = static member TryCancelled(computation: Async2<'T>, compensation) = async2 { let! ct = Async2.CancellationToken - let task = Async2.start ct computation + let invocation = computation.StartImmediate ct try - return! task + return! invocation finally - if task.IsCanceled then + if invocation.Task.IsCanceled then compensation () } static member StartChild(computation: Async2<'T>) : Async2> = async2 { let! ct = Async2.CancellationToken - return async2 { return! computation |> Async2.start ct } + return async2 { return! computation |> Async2.startInThreadPool ct } } static member StartChildAsTask(computation: Async2<'T>) : Async2> = async2 { let! ct = Async2.CancellationToken - let task = computation |> Async2.start ct + let task = computation |> Async2.startInThreadPool ct return task } diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 92c9f61621..a18c65d78e 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12455,8 +12455,8 @@ Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult$W[a,b](Micr Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult[a,b](a) Internal.Utilities.Library.Async2Implementation+BindContext: Boolean IncrementBindCount() Internal.Utilities.Library.Async2Implementation+BindContext: Int32 bindLimit -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.AsyncLocal`1[System.Boolean] get_started() -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.AsyncLocal`1[System.Boolean] started +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Boolean] get_started() +Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Boolean] started Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] bindCount Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() Internal.Utilities.Library.Async2Implementation+BindContext: Void Reset() From 214f13f2ca7f2ae5ab2e57ae13c4e598b3d6268e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 1 Oct 2025 16:35:41 +0200 Subject: [PATCH 46/48] use thread pool for stack guad on net core --- src/Compiler/Facilities/DiagnosticsLogger.fs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 9fa521d035..333db1ab9c 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -952,12 +952,15 @@ type StackGuard(maxDepth: int, name: string) = StackGuardMetrics.countJump memberName $"{fileName}:{line}" - async2 { - do! Async.SwitchToNewThread() - Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" - return f () - } - |> Async2.RunImmediate + if Environment.Version.Major > 4 then + async2 { return f() } |> Async2.runWithoutCancellation + else + async { + do! Async.SwitchToNewThread() + Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" + return f () + } + |> Async.RunImmediate else f () finally From e4ab6c78a51161e8b10c1a678431b34140bf3470 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 1 Oct 2025 16:50:09 +0200 Subject: [PATCH 47/48] temp bsl --- .../FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index a18c65d78e..f02915451e 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -12455,8 +12455,6 @@ Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult$W[a,b](Micr Internal.Utilities.Library.Async2Implementation+Awaiter: b getResult[a,b](a) Internal.Utilities.Library.Async2Implementation+BindContext: Boolean IncrementBindCount() Internal.Utilities.Library.Async2Implementation+BindContext: Int32 bindLimit -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Boolean] get_started() -Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Boolean] started Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] bindCount Internal.Utilities.Library.Async2Implementation+BindContext: System.Threading.ThreadLocal`1[System.Int32] get_bindCount() Internal.Utilities.Library.Async2Implementation+BindContext: Void Reset() @@ -12514,6 +12512,8 @@ Internal.Utilities.Library.Async2Implementation+ExceptionCache: System.Runtime.E Internal.Utilities.Library.Async2Implementation+ExceptionCache: a Throw[a](System.Exception) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow$W[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,b], Microsoft.FSharp.Core.FSharpFunc`2[a,System.Boolean], a) Internal.Utilities.Library.Async2Implementation+ExceptionCache: b GetResultOrThrow[a,b](a) +Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean Running +Internal.Utilities.Library.Async2Implementation+Trampoline: Boolean get_Running() Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] Ref Internal.Utilities.Library.Async2Implementation+Trampoline: Microsoft.FSharp.Core.FSharpRef`1[System.Runtime.CompilerServices.ICriticalNotifyCompletion] get_Ref() Internal.Utilities.Library.Async2Implementation+Trampoline: Trampoline Current @@ -12536,7 +12536,8 @@ Internal.Utilities.Library.Async2Module: Microsoft.FSharp.Control.FSharpAsync`1[ Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] CheckAndThrowToken Internal.Utilities.Library.Async2Module: System.Threading.AsyncLocal`1[System.Threading.CancellationToken] get_CheckAndThrowToken() Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] startAsTaskWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) -Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] start[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[a] start[a](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[a]) +Internal.Utilities.Library.Async2Module: System.Threading.Tasks.Task`1[t] startInThreadPool[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2Module: a runWithoutCancellation[a](Internal.Utilities.Library.Async2`1[a]) Internal.Utilities.Library.Async2Module: t run[t](System.Threading.CancellationToken, Internal.Utilities.Library.Async2`1[t]) Internal.Utilities.Library.Async2`1[t]: Internal.Utilities.Library.IAsync2Invocation`1[t] StartImmediate(System.Threading.CancellationToken) From 0a7f23190c04b2d98ffc123f7b396ae955ed7dff Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 2 Oct 2025 18:01:54 +0200 Subject: [PATCH 48/48] fix --- src/Compiler/Utilities/Async2.fs | 9 +++------ .../CompilerService/AsyncMemoize.fs | 6 ++++-- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Utilities/Async2.fs b/src/Compiler/Utilities/Async2.fs index 49f9014657..109960f8be 100644 --- a/src/Compiler/Utilities/Async2.fs +++ b/src/Compiler/Utilities/Async2.fs @@ -101,8 +101,6 @@ module Async2Implementation = member this.Ref: ICriticalNotifyCompletion ref = ref this - member _.Running = running - static member Current = holder.Value module ExceptionCache = @@ -482,8 +480,7 @@ module Async2 = let inline start ct (code: Async2<_>) = let immediate = - not Trampoline.Current.Running // prevent deadlock, TODO: better solution? - && isNull SynchronizationContext.Current + isNull SynchronizationContext.Current && TaskScheduler.Current = TaskScheduler.Default if immediate then @@ -538,7 +535,7 @@ type Async2 = static member StartAsTask(computation: Async2<_>, ?cancellationToken: CancellationToken) : Task<_> = let ct = defaultArg cancellationToken CancellationToken.None - Async2.startInThreadPool ct computation + Async2.start ct computation static member RunImmediate(computation: Async2<'T>, ?cancellationToken: CancellationToken) : 'T = let ct = defaultArg cancellationToken CancellationToken.None @@ -593,7 +590,7 @@ type Async2 = try return! invocation finally - if invocation.Task.IsCanceled then + if ct.IsCancellationRequested && invocation.Task.IsCanceled then compensation () } diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 8519bb4296..b932c0c118 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -37,7 +37,9 @@ let rec awaitEvents next condition = async { match! next () with | events when condition events -> return events - | _ -> return! awaitEvents next condition + | _ -> + do! Async.Sleep 1 + return! awaitEvents next condition } let rec eventsWhen next condition = @@ -395,7 +397,7 @@ let ``Stress test`` () = Assert.True ((float completed) > ((float started) * 0.1), "Less than 10 % completed jobs") -[] +[] let ``Cancel running jobs with the same key`` () = let cache = AsyncMemoize(cancelUnawaitedJobs = false, cancelDuplicateRunningJobs = true)