From 1ed396eb586a383e95c32bf3083ef9aafe0cf248 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 5 Jul 2025 23:00:51 +0200 Subject: [PATCH 01/14] resumable cancellable with trampolining binds --- src/Compiler/Checking/CheckDeclarations.fs | 59 ++-- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 - src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 - src/Compiler/Service/FSharpCheckerResults.fs | 2 +- src/Compiler/Utilities/Cancellable.fs | 315 +++++++++++------- src/Compiler/Utilities/Cancellable.fsi | 127 +++++-- 6 files changed, 311 insertions(+), 198 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index adcd4d80f30..7f943b5f305 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4869,7 +4869,7 @@ module TcDeclarations = //------------------------------------------------------------------------- // Bind module types //------------------------------------------------------------------------- - +#nowarn FS3511 let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Cancellable = cancellable { let g = cenv.g @@ -5042,8 +5042,14 @@ and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = return! TcSignatureElementsNonMutRec cenv parent typeNames endm env defs } -and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = - Cancellable.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs +and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = + cancellable { + 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) = cancellable { @@ -5370,7 +5376,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 @@ -5462,7 +5467,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 = @@ -5498,14 +5502,11 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem } /// 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) = + cancellable { 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 = @@ -5514,14 +5515,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 = cancellable { @@ -5546,21 +5542,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) } @@ -5797,7 +5787,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 eb96a5f6e0b..1ef603a2a9e 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: Cancellable<'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 02471dd383b..f545babce8d 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.Cancellable<'T> -> Internal.Utilities.Library.Cancellable<'T> - static member GetDepthOption: string -> int /// This represents the global state established as each task function runs as part of the build. diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index aa23d1534ab..a6a760e0580 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -118,7 +118,7 @@ type DelayedILModuleReader = None | _ -> Some this.result) } - | _ -> cancellable.Return(Some this.result) + | _ -> cancellable { return Some this.result } [] type FSharpReferencedProject = diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index bae9c6f8299..4cfc6255170 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -1,3 +1,4 @@ +#nowarn FS3513 namespace FSharp.Compiler open System @@ -51,7 +52,7 @@ type Cancellable = | ValueNone -> () | ValueSome token -> token.ThrowIfCancellationRequested() -namespace Internal.Utilities.Library +namespace Internal.Utilities.Library.CancellableImplementation open System open System.Threading @@ -59,168 +60,240 @@ open FSharp.Compiler open FSharp.Core.CompilerServices.StateMachineHelpers -[] -type ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException +open Microsoft.FSharp.Core.CompilerServices +open System.Runtime.CompilerServices +open System.Runtime.ExceptionServices -[] -type Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) +type ITrampolineInvocation = + abstract member MoveNext: unit -> unit + abstract IsCompleted: bool -module Cancellable = +and [] Trampoline() = - 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 + static let currentThreadTrampoline = new ThreadLocal<_>(fun () -> Trampoline()) - let fold f acc seq = - Cancellable(fun ct -> - let mutable acc = ValueOrCancelled.Value acc + let stack = System.Collections.Generic.Stack() - for x in seq do - match acc with - | ValueOrCancelled.Value accv -> acc <- run ct (f accv x) - | ValueOrCancelled.Cancelled _ -> () + member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) - acc) + static member CurrentThreadTrampoline = currentThreadTrampoline.Value - let runWithoutCancellation comp = - use _ = Cancellable.UsingToken CancellationToken.None - let res = run CancellationToken.None comp + member this.Execute(invocation) = + stack.Push invocation - match res with - | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" - | ValueOrCancelled.Value r -> r + while stack.Count > 0 do + stack.Peek().MoveNext() - let toAsync c = - async { - use! _holder = Cancellable.UseToken() + if stack.Peek().IsCompleted then + stack.Pop() |> ignore - let! ct = Async.CancellationToken +[] +type CancellableData<'T> = - return! - Async.FromContinuations(fun (cont, _econt, ccont) -> - match run ct c with - | ValueOrCancelled.Value v -> cont v - | ValueOrCancelled.Cancelled ce -> ccont ce) - } + [] + val mutable Result: Result<'T, ExceptionDispatchInfo> + + member this.GetValue() = + match this.Result with + | Ok value -> value + | Error edi -> + edi.Throw() + Unchecked.defaultof<_> + +type ITrampolineInvocation<'T> = + inherit ITrampolineInvocation + abstract Hijack: unit -> unit + abstract Data: CancellableData<'T> + +type IMachineTemplateWrapper<'T> = + abstract Clone: unit -> ITrampolineInvocation<'T> + +type ICancellableStateMachine<'T> = IResumableStateMachine> +type CancellableStateMachine<'T> = ResumableStateMachine> +type CancellableResumptionFunc<'T> = ResumptionFunc> +type CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo> +type CancellableCode<'Data, 'T> = ResumableCode, 'T> - let token () = Cancellable(ValueOrCancelled.Value) +[] +type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) + = + + let mutable machine = machine + + interface ITrampolineInvocation<'T> with + member _.MoveNext() = machine.MoveNext() + member _.IsCompleted = machine.ResumptionPoint = -1 + member _.Data = machine.Data + + member this.Hijack() = + Trampoline.CurrentThreadTrampoline.Set this + + interface IMachineTemplateWrapper<'T> with + member _.Clone() = CancellableInvocation<_, _>(machine) + +[] +type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = + + member _.GetInvocation() = template.Clone() + +module CancellableCode = + let inline WithCancelCheck (body: CancellableCode<'Data, 'T>) = + CancellableCode<'Data, 'T>(fun sm -> + Cancellable.Token.ThrowIfCancellationRequested() + body.Invoke(&sm)) + + let inline FilterOce ([] catch: exn -> CancellableCode<'Data, 'T>) (exn: exn) = + CancellableCode<'Data, 'T>(fun sm -> + match exn with + | :? OperationCanceledException as oce when oce.CancellationToken = Cancellable.Token -> true + | _ -> (catch exn).Invoke(&sm)) type CancellableBuilder() = - member inline _.Delay([] f) = - Cancellable(fun ct -> - let (Cancellable g) = f () - g ct) + member inline _.Zero() : CancellableCode<'Data, unit> = ResumableCode.Zero() - member inline _.Bind(comp, [] k) = - Cancellable(fun ct -> + member inline _.For(sequence, body) : CancellableCode<'Data, unit> = ResumableCode.For(sequence, body) - __debugPoint "" + member inline _.While(condition, body) : CancellableCode<'Data, unit> = + ResumableCode.While(condition, CancellableCode.WithCancelCheck body) - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> Cancellable.run ct (k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) + member inline _.Delay(generator: unit -> CancellableCode<'Data, 'T>) = + CancellableCode<'Data, 'T>(fun sm -> (generator ()).Invoke(&sm)) - member inline _.BindReturn(comp, [] k) = - Cancellable(fun ct -> + member inline _.Combine(code1, code2) = + ResumableCode.Combine(CancellableCode.WithCancelCheck code1, CancellableCode.WithCancelCheck code2) - __debugPoint "" + member inline _.Using(resource, body) : CancellableCode<'Data, 'T> = ResumableCode.Using(resource, body) - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) + member inline _.TryWith(body, catch) : CancellableCode<'Data, 'T> = + ResumableCode.TryWith(CancellableCode.WithCancelCheck body, (CancellableCode.FilterOce catch)) - member inline _.Combine(comp1, comp2) = - Cancellable(fun ct -> + member inline _.TryFinally(body: CancellableCode<'Data, 'T>, compensation) : CancellableCode<'Data, 'T> = + ResumableCode.TryFinally( + CancellableCode.WithCancelCheck body, + ResumableCode(fun _sm -> + compensation () + true) + ) - __debugPoint "" + member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = + CancellableCode(fun sm -> + sm.Data.Result <- Ok value + true) - match Cancellable.run ct comp1 with - | ValueOrCancelled.Value() -> Cancellable.run ct comp2 - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) + member inline this.Yield(value) = this.Return(value) - member inline _.TryWith(comp, [] handler) = - Cancellable(fun ct -> + member inline _.Bind + (code: Cancellable<'U>, [] continuation: 'U -> CancellableCode<'Data, 'T>) + : CancellableCode<'Data, 'T> = + CancellableCode(fun sm -> + if __useResumableCode then + let mutable invocation = code.GetInvocation() - __debugPoint "" + let __stack_yield_complete = ResumableCode.Yield().Invoke(&sm) - 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) + if __stack_yield_complete then + (invocation.Data.GetValue() |> continuation).Invoke(&sm) + else + invocation.Hijack() + false + else + // Dynamic Bind. - 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) + let mutable invocation = code.GetInvocation() - member inline _.Using(resource: _ MaybeNull, [] comp) = - Cancellable(fun ct -> + let cont = + CancellableResumptionFunc<'Data>(fun sm -> (invocation.Data.GetValue() |> continuation).Invoke(&sm)) - __debugPoint "" + invocation.Hijack() + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false) - let body = comp resource + member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) - 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) + member inline _.Run(code: CancellableCode<'T, 'T>) : Cancellable<'T> = + if __useResumableCode then + __stateMachine, Cancellable<'T>> - match compRes with - | ValueOrCancelled.Value res -> - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource + (MoveNextMethodImpl<_>(fun sm -> + __resumeAt sm.ResumptionPoint - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) + try + let __stack_code_fin = (CancellableCode.WithCancelCheck code).Invoke(&sm) - member inline _.TryFinally(comp, [] compensation) = - Cancellable(fun ct -> + if __stack_code_fin then + sm.ResumptionPoint <- -1 + with exn -> + sm.Data.Result <- Error(ExceptionDispatchInfo.Capture exn) + sm.ResumptionPoint <- -1)) - __debugPoint "" + (SetStateMachineMethodImpl<_>(fun _ _ -> ())) - 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) + (AfterCode<_, _>(fun sm -> + sm.Data <- CancellableData() + Cancellable(CancellableInvocation<_, _>(sm)))) + else + // Dynamic Run. - match compRes with - | ValueOrCancelled.Value res -> - compensation () + let initialResumptionFunc = + CancellableResumptionFunc(fun sm -> (CancellableCode.WithCancelCheck code).Invoke(&sm)) + + let resumptionInfo = + { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with + member info.MoveNext(sm) = + try + if info.ResumptionFunc.Invoke(&sm) then + sm.ResumptionPoint <- -1 + with exn -> + sm.Data.Result <- Error(ExceptionDispatchInfo.Capture exn) + sm.ResumptionPoint <- -1 + + member _.SetStateMachine(_, _) = () + } - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) + let sm = + CancellableStateMachine(ResumptionDynamicInfo = resumptionInfo, Data = CancellableData()) - member inline _.Return v = - Cancellable(fun _ -> ValueOrCancelled.Value v) + Cancellable(CancellableInvocation(sm)) + +namespace Internal.Utilities.Library - member inline _.ReturnFrom(v: Cancellable<'T>) = v +open System +open System.Threading - member inline _.Zero() = - Cancellable(fun _ -> ValueOrCancelled.Value()) +type Cancellable<'T> = CancellableImplementation.Cancellable<'T> [] module CancellableAutoOpens = - let cancellable = CancellableBuilder() + + let cancellable = CancellableImplementation.CancellableBuilder() + +module Cancellable = + open Internal.Utilities.Library.CancellableImplementation + + let run ct (code: Cancellable<_>) = + use _ = FSharp.Compiler.Cancellable.UsingToken ct + + let invocation = code.GetInvocation() + Trampoline.CurrentThreadTrampoline.Execute invocation + invocation + + let runWithoutCancellation code = + run CancellationToken.None code |> _.Data.GetValue() + + let toAsync (code: Cancellable<_>) = + async { + let! ct = Async.CancellationToken + + return! + Async.FromContinuations(fun (cont, econt, ccont) -> + match run ct code |> _.Data.Result with + | Ok value -> cont value + | Error edi -> + match edi.SourceException with + | :? OperationCanceledException as oce when oce.CancellationToken = ct -> ccont oce + | exn -> econt exn) + } + + let token () = + cancellable { FSharp.Compiler.Cancellable.Token } diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 0d82faa68cb..eb2464699de 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -13,67 +13,124 @@ type Cancellable = static member CheckAndThrow: unit -> unit static member TryCheckAndThrow: unit -> unit -namespace Internal.Utilities.Library +namespace Internal.Utilities.Library.CancellableImplementation open System -open System.Threading +open Microsoft.FSharp.Core.CompilerServices +open System.Runtime.CompilerServices +open System.Runtime.ExceptionServices -[] -type internal ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException +type internal ITrampolineInvocation = -/// 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>) + abstract MoveNext: unit -> unit -module internal Cancellable = + abstract IsCompleted: bool - /// Run a cancellable computation using the given cancellation token - val inline run: ct: CancellationToken -> Cancellable<'T> -> ValueOrCancelled<'T> +and [] internal Trampoline = class end - val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> +[] +type internal CancellableData<'T> = - /// 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 + [] + val mutable Result: Result<'T, ExceptionDispatchInfo> - /// Bind the cancellation token associated with the computation - val token: unit -> Cancellable + member GetValue: unit -> 'T + +type internal ITrampolineInvocation<'T> = + inherit ITrampolineInvocation + + abstract Hijack: unit -> unit + + abstract Data: CancellableData<'T> + +type internal IMachineTemplateWrapper<'T> = + abstract Clone: unit -> ITrampolineInvocation<'T> + + +type internal ICancellableStateMachine<'T> = IResumableStateMachine> + +type internal CancellableStateMachine<'T> = ResumableStateMachine> + +type internal CancellableResumptionFunc<'T> = ResumptionFunc> + +type internal CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo> + +type internal CancellableCode<'Data, 'T> = ResumableCode, 'T> + +[] +type internal CancellableInvocation<'T, 'Machine + when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> = + interface IMachineTemplateWrapper<'T> + interface ITrampolineInvocation<'T> + + new: machine: 'Machine -> CancellableInvocation<'T, 'Machine> + +[] +type internal Cancellable<'T> = + + new: template: IMachineTemplateWrapper<'T> -> Cancellable<'T> - val toAsync: Cancellable<'T> -> Async<'T> + member GetInvocation: unit -> ITrampolineInvocation<'T> + +module internal CancellableCode = + + val inline WithCancelCheck: body: CancellableCode<'Data, 'T> -> CancellableCode<'Data, 'T> + + val inline FilterOce: + [] catch: (exn -> CancellableCode<'Data, 'T>) -> exn: exn -> CancellableCode<'Data, 'T> type internal CancellableBuilder = new: unit -> CancellableBuilder - member inline BindReturn: comp: Cancellable<'T> * [] k: ('T -> 'U) -> Cancellable<'U> + member inline Bind: + code: Cancellable<'U> * [] continuation: ('U -> CancellableCode<'Data, 'T>) -> + CancellableCode<'Data, 'T> - member inline Bind: comp: Cancellable<'T> * [] k: ('T -> Cancellable<'U>) -> Cancellable<'U> + member inline Combine: + code1: CancellableCode<'c, unit> * code2: CancellableCode<'c, 'd> -> ResumableCode, 'd> - member inline Combine: comp1: Cancellable * comp2: Cancellable<'T> -> Cancellable<'T> + member inline Delay: generator: (unit -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> - member inline Delay: [] f: (unit -> Cancellable<'T>) -> Cancellable<'T> + member inline For: sequence: 'e seq * body: ('e -> CancellableCode<'Data, unit>) -> CancellableCode<'Data, unit> - member inline Return: v: 'T -> Cancellable<'T> + member inline Return: value: 'T -> CancellableCode<'T, 'T> - member inline ReturnFrom: v: Cancellable<'T> -> Cancellable<'T> + member inline ReturnFrom: comp: Cancellable<'T> -> CancellableCode<'T, 'T> - member inline TryFinally: comp: Cancellable<'T> * [] compensation: (unit -> unit) -> Cancellable<'T> + member inline Run: code: CancellableCode<'T, 'T> -> Cancellable<'T> + + member inline TryFinally: + body: CancellableCode<'Data, 'T> * compensation: (unit -> unit) -> CancellableCode<'Data, 'T> member inline TryWith: - comp: Cancellable<'T> * [] handler: (exn -> Cancellable<'T>) -> Cancellable<'T> + body: CancellableCode<'Data, 'T> * catch: (exn -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, '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 + resource: 'b * body: ('b -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> + when 'b :> IDisposable | null + + member inline While: condition: (unit -> bool) * body: CancellableCode<'Data, unit> -> CancellableCode<'Data, unit> + + member inline Yield: value: 'a -> CancellableCode<'a, 'a> + + member inline Zero: unit -> CancellableCode<'Data, unit> + +namespace Internal.Utilities.Library - member inline Zero: unit -> Cancellable +open System.Threading + +type internal Cancellable<'T> = CancellableImplementation.Cancellable<'T> [] module internal CancellableAutoOpens = - val cancellable: CancellableBuilder + + val cancellable: CancellableImplementation.CancellableBuilder + +module internal Cancellable = + + val runWithoutCancellation: code: Cancellable<'a> -> 'a + + val toAsync: code: Cancellable<'a> -> Async<'a> + + val token: unit -> Cancellable From e0c77aba0291625a3cbbb177ff4384c886f95f02 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 5 Jul 2025 23:47:34 +0200 Subject: [PATCH 02/14] format --- src/Compiler/Utilities/Cancellable.fsi | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index eb2464699de..8efa6038d3c 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -46,7 +46,6 @@ type internal ITrampolineInvocation<'T> = type internal IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> - type internal ICancellableStateMachine<'T> = IResumableStateMachine> type internal CancellableStateMachine<'T> = ResumableStateMachine> From d3b9cb61b7cd6ccfa398ee35ec8496c4ce2715cb Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Jul 2025 09:28:04 +0200 Subject: [PATCH 03/14] move boundary crossing execution state out of state machines --- src/Compiler/Utilities/Cancellable.fs | 186 ++++++++++++++----------- src/Compiler/Utilities/Cancellable.fsi | 43 +++--- 2 files changed, 120 insertions(+), 109 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 4cfc6255170..71bf6a50a10 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -68,17 +68,27 @@ type ITrampolineInvocation = abstract member MoveNext: unit -> unit abstract IsCompleted: bool -and [] Trampoline() = +[] +type ExecutionState = + | Running + | Complete + | Cancelled of oce: OperationCanceledException + | Error of edi: ExceptionDispatchInfo + +[] +type Trampoline() = - static let currentThreadTrampoline = new ThreadLocal<_>(fun () -> Trampoline()) + static let current = new ThreadLocal<_>(fun () -> Trampoline()) let stack = System.Collections.Generic.Stack() - member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) + member val State: ExecutionState = Running with get, set - static member CurrentThreadTrampoline = currentThreadTrampoline.Value + member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) member this.Execute(invocation) = + this.State <- Running + stack.Push invocation while stack.Count > 0 do @@ -87,32 +97,20 @@ and [] Trampoline() = if stack.Peek().IsCompleted then stack.Pop() |> ignore -[] -type CancellableData<'T> = - - [] - val mutable Result: Result<'T, ExceptionDispatchInfo> - - member this.GetValue() = - match this.Result with - | Ok value -> value - | Error edi -> - edi.Throw() - Unchecked.defaultof<_> + static member Current = current.Value type ITrampolineInvocation<'T> = inherit ITrampolineInvocation - abstract Hijack: unit -> unit - abstract Data: CancellableData<'T> + abstract Data: 'T type IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> -type ICancellableStateMachine<'T> = IResumableStateMachine> -type CancellableStateMachine<'T> = ResumableStateMachine> -type CancellableResumptionFunc<'T> = ResumptionFunc> -type CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo> -type CancellableCode<'Data, 'T> = ResumableCode, 'T> +type ICancellableStateMachine<'T> = IResumableStateMachine<'T> +type CancellableStateMachine<'T> = ResumableStateMachine<'T> +type CancellableResumptionFunc<'T> = ResumptionFunc<'T> +type CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo<'T> +type CancellableCode<'Data, 'T> = ResumableCode<'Data, 'T> [] type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) @@ -125,9 +123,6 @@ type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and member _.IsCompleted = machine.ResumptionPoint = -1 member _.Data = machine.Data - member this.Hijack() = - Trampoline.CurrentThreadTrampoline.Set this - interface IMachineTemplateWrapper<'T> with member _.Clone() = CancellableInvocation<_, _>(machine) @@ -136,41 +131,60 @@ type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = member _.GetInvocation() = template.Clone() -module CancellableCode = - let inline WithCancelCheck (body: CancellableCode<'Data, 'T>) = - CancellableCode<'Data, 'T>(fun sm -> - Cancellable.Token.ThrowIfCancellationRequested() - body.Invoke(&sm)) - - let inline FilterOce ([] catch: exn -> CancellableCode<'Data, 'T>) (exn: exn) = - CancellableCode<'Data, 'T>(fun sm -> - match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = Cancellable.Token -> true - | _ -> (catch exn).Invoke(&sm)) - type CancellableBuilder() = + + // Delay checks for cancellation and skips further steps when Cancelled / Errored. + member inline _.Delay(generator: unit -> CancellableCode<'Data, 'T>) = + CancellableCode<'Data, 'T>(fun sm -> + if Cancellable.Token.IsCancellationRequested then + Trampoline.Current.State <- Cancelled(OperationCanceledException Cancellable.Token) + + match Trampoline.Current.State with + | Running -> + try + (generator ()).Invoke(&sm) + with + | :? OperationCanceledException as oce when oce.CancellationToken = Cancellable.Token -> + Trampoline.Current.State <- Cancelled oce + true + | _exn -> + Trampoline.Current.State <- Error(ExceptionDispatchInfo.Capture _exn) + true + | _ -> true) member inline _.Zero() : CancellableCode<'Data, unit> = ResumableCode.Zero() member inline _.For(sequence, body) : CancellableCode<'Data, unit> = ResumableCode.For(sequence, body) - member inline _.While(condition, body) : CancellableCode<'Data, unit> = - ResumableCode.While(condition, CancellableCode.WithCancelCheck body) - - member inline _.Delay(generator: unit -> CancellableCode<'Data, 'T>) = - CancellableCode<'Data, 'T>(fun sm -> (generator ()).Invoke(&sm)) + member inline _.While(condition, body) : CancellableCode<'Data, unit> = ResumableCode.While(condition, body) - member inline _.Combine(code1, code2) = - ResumableCode.Combine(CancellableCode.WithCancelCheck code1, CancellableCode.WithCancelCheck code2) + member inline _.Combine(code1, code2) : CancellableCode<'Data, 'T> = ResumableCode.Combine(code1, code2) member inline _.Using(resource, body) : CancellableCode<'Data, 'T> = ResumableCode.Using(resource, body) - member inline _.TryWith(body, catch) : CancellableCode<'Data, 'T> = - ResumableCode.TryWith(CancellableCode.WithCancelCheck body, (CancellableCode.FilterOce catch)) + member inline _.TryWith(body: CancellableCode<'Data, 'T>, catch: exn -> CancellableCode<'Data, 'T>) : CancellableCode<'Data, 'T> = + CancellableCode(fun sm -> + let __stack_body_fin = body.Invoke(&sm) + + match Trampoline.Current.State with + | Error edi when __stack_body_fin -> + try + Trampoline.Current.State <- Running + (catch edi.SourceException).Invoke(&sm) + with + // Unhandled, restore state. + | exn when exn = edi.SourceException -> + Trampoline.Current.State <- Error edi + true + // Exception in handler. + | _newExn -> + Trampoline.Current.State <- Error(ExceptionDispatchInfo.Capture _newExn) + true + | _ -> __stack_body_fin) member inline _.TryFinally(body: CancellableCode<'Data, 'T>, compensation) : CancellableCode<'Data, 'T> = ResumableCode.TryFinally( - CancellableCode.WithCancelCheck body, + body, ResumableCode(fun _sm -> compensation () true) @@ -178,7 +192,7 @@ type CancellableBuilder() = member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode(fun sm -> - sm.Data.Result <- Ok value + sm.Data <- value true) member inline this.Yield(value) = this.Return(value) @@ -190,22 +204,30 @@ type CancellableBuilder() = if __useResumableCode then let mutable invocation = code.GetInvocation() - let __stack_yield_complete = ResumableCode.Yield().Invoke(&sm) - - if __stack_yield_complete then - (invocation.Data.GetValue() |> continuation).Invoke(&sm) - else - invocation.Hijack() + match __resumableEntry () with + | Some contID -> + sm.ResumptionPoint <- contID + Trampoline.Current.Set invocation false + | None -> + if Trampoline.Current.State.IsRunning then + (invocation.Data |> continuation).Invoke(&sm) + else + true + else // Dynamic Bind. let mutable invocation = code.GetInvocation() let cont = - CancellableResumptionFunc<'Data>(fun sm -> (invocation.Data.GetValue() |> continuation).Invoke(&sm)) + CancellableResumptionFunc<'Data>(fun sm -> + if Trampoline.Current.State.IsRunning then + (invocation.Data |> continuation).Invoke(&sm) + else + true) - invocation.Hijack() + Trampoline.Current.Set invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont false) @@ -213,46 +235,33 @@ type CancellableBuilder() = member inline _.Run(code: CancellableCode<'T, 'T>) : Cancellable<'T> = if __useResumableCode then - __stateMachine, Cancellable<'T>> + __stateMachine<'T, Cancellable<'T>> (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint + let __stack_code_fin = code.Invoke(&sm) - try - let __stack_code_fin = (CancellableCode.WithCancelCheck code).Invoke(&sm) - - if __stack_code_fin then - sm.ResumptionPoint <- -1 - with exn -> - sm.Data.Result <- Error(ExceptionDispatchInfo.Capture exn) + if __stack_code_fin then sm.ResumptionPoint <- -1)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) - (AfterCode<_, _>(fun sm -> - sm.Data <- CancellableData() - Cancellable(CancellableInvocation<_, _>(sm)))) + (AfterCode<_, _>(fun sm -> Cancellable(CancellableInvocation(sm)))) else // Dynamic Run. - let initialResumptionFunc = - CancellableResumptionFunc(fun sm -> (CancellableCode.WithCancelCheck code).Invoke(&sm)) + let initialResumptionFunc = CancellableResumptionFunc(fun sm -> code.Invoke(&sm)) let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = - try - if info.ResumptionFunc.Invoke(&sm) then - sm.ResumptionPoint <- -1 - with exn -> - sm.Data.Result <- Error(ExceptionDispatchInfo.Capture exn) + if info.ResumptionFunc.Invoke(&sm) then sm.ResumptionPoint <- -1 member _.SetStateMachine(_, _) = () } - let sm = - CancellableStateMachine(ResumptionDynamicInfo = resumptionInfo, Data = CancellableData()) + let sm = CancellableStateMachine(ResumptionDynamicInfo = resumptionInfo) Cancellable(CancellableInvocation(sm)) @@ -275,11 +284,18 @@ module Cancellable = use _ = FSharp.Compiler.Cancellable.UsingToken ct let invocation = code.GetInvocation() - Trampoline.CurrentThreadTrampoline.Execute invocation + Trampoline.Current.Execute invocation invocation let runWithoutCancellation code = - run CancellationToken.None code |> _.Data.GetValue() + let invocation = run CancellationToken.None code + + match Trampoline.Current.State with + | Error edi -> + edi.Throw() + Unchecked.defaultof<_> + | Cancelled _ -> failwith "Unexpected cancel in runWithoutCancellation." + | _ -> invocation.Data let toAsync (code: Cancellable<_>) = async { @@ -287,12 +303,12 @@ module Cancellable = return! Async.FromContinuations(fun (cont, econt, ccont) -> - match run ct code |> _.Data.Result with - | Ok value -> cont value - | Error edi -> - match edi.SourceException with - | :? OperationCanceledException as oce when oce.CancellationToken = ct -> ccont oce - | exn -> econt exn) + let invocation = run ct code + + match Trampoline.Current.State with + | Cancelled oce -> ccont oce + | Error edi -> econt edi.SourceException + | _ -> cont invocation.Data) } let token () = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 8efa6038d3c..434f7d1e718 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -16,6 +16,7 @@ type Cancellable = namespace Internal.Utilities.Library.CancellableImplementation open System +open System.Threading open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices open System.Runtime.ExceptionServices @@ -26,35 +27,36 @@ type internal ITrampolineInvocation = abstract IsCompleted: bool -and [] internal Trampoline = class end - -[] -type internal CancellableData<'T> = +[] +type internal ExecutionState = + | Running + | Complete + | Cancelled of oce: OperationCanceledException + | Error of edi: ExceptionDispatchInfo - [] - val mutable Result: Result<'T, ExceptionDispatchInfo> - - member GetValue: unit -> 'T +[] +type internal Trampoline = + member State: ExecutionState with get, set + member Set: ITrampolineInvocation -> unit + static member Current: Trampoline type internal ITrampolineInvocation<'T> = inherit ITrampolineInvocation - abstract Hijack: unit -> unit - - abstract Data: CancellableData<'T> + abstract Data: 'T type internal IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> -type internal ICancellableStateMachine<'T> = IResumableStateMachine> +type internal ICancellableStateMachine<'T> = IResumableStateMachine<'T> -type internal CancellableStateMachine<'T> = ResumableStateMachine> +type internal CancellableStateMachine<'T> = ResumableStateMachine<'T> -type internal CancellableResumptionFunc<'T> = ResumptionFunc> +type internal CancellableResumptionFunc<'T> = ResumptionFunc<'T> -type internal CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo> +type internal CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo<'T> -type internal CancellableCode<'Data, 'T> = ResumableCode, 'T> +type internal CancellableCode<'Data, 'T> = ResumableCode<'Data, 'T> [] type internal CancellableInvocation<'T, 'Machine @@ -71,13 +73,6 @@ type internal Cancellable<'T> = member GetInvocation: unit -> ITrampolineInvocation<'T> -module internal CancellableCode = - - val inline WithCancelCheck: body: CancellableCode<'Data, 'T> -> CancellableCode<'Data, 'T> - - val inline FilterOce: - [] catch: (exn -> CancellableCode<'Data, 'T>) -> exn: exn -> CancellableCode<'Data, 'T> - type internal CancellableBuilder = new: unit -> CancellableBuilder @@ -87,7 +82,7 @@ type internal CancellableBuilder = CancellableCode<'Data, 'T> member inline Combine: - code1: CancellableCode<'c, unit> * code2: CancellableCode<'c, 'd> -> ResumableCode, 'd> + code1: CancellableCode<'Data, unit> * code2: CancellableCode<'Data, 'T> -> CancellableCode<'Data, 'T> member inline Delay: generator: (unit -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> From c4d32f25db0d35293d487c946a7013570ccabcf4 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Jul 2025 14:07:18 +0200 Subject: [PATCH 04/14] format --- src/Compiler/Utilities/Cancellable.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 71bf6a50a10..1e5f7104c62 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -132,7 +132,7 @@ type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = member _.GetInvocation() = template.Clone() type CancellableBuilder() = - + // Delay checks for cancellation and skips further steps when Cancelled / Errored. member inline _.Delay(generator: unit -> CancellableCode<'Data, 'T>) = CancellableCode<'Data, 'T>(fun sm -> From ed53227cea8bc8ef68082f9fcb00b90bd6a98722 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Jul 2025 18:10:48 +0200 Subject: [PATCH 05/14] add cancellation to While --- src/Compiler/Utilities/Cancellable.fs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 1e5f7104c62..6bde9f4068d 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -154,9 +154,22 @@ type CancellableBuilder() = member inline _.Zero() : CancellableCode<'Data, unit> = ResumableCode.Zero() - member inline _.For(sequence, body) : CancellableCode<'Data, unit> = ResumableCode.For(sequence, body) - - member inline _.While(condition, body) : CancellableCode<'Data, unit> = ResumableCode.While(condition, body) + member inline _.While(condition, body) : CancellableCode<'Data, unit> = + ResumableCode.While((fun () -> Trampoline.Current.State.IsRunning && condition ()), body) + + member inline this.For(sequence: seq<'T>, body: 'T -> CancellableCode<'Data, unit>) : CancellableCode<'Data, unit> = + // A for loop is just a using statement on the sequence's enumerator... + ResumableCode.Using( + sequence.GetEnumerator(), + // ... and its body is a while loop that advances the enumerator and runs the body on each element. + (fun e -> + this.While( + (fun () -> + __debugPoint "ForLoop.InOrToKeyword" + e.MoveNext()), + CancellableCode<'Data, unit>(fun sm -> (body e.Current).Invoke(&sm)) + )) + ) member inline _.Combine(code1, code2) : CancellableCode<'Data, 'T> = ResumableCode.Combine(code1, code2) From 73663fa4878ef8ecc64af7ccd4dd8f116ffbc3ee Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Jul 2025 18:11:45 +0200 Subject: [PATCH 06/14] bind depth limit --- src/Compiler/Utilities/Cancellable.fs | 57 +++++++++++++++++--------- src/Compiler/Utilities/Cancellable.fsi | 2 + 2 files changed, 39 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 6bde9f4068d..294ca18fb98 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -63,6 +63,7 @@ open FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices open System.Runtime.ExceptionServices +open System.Diagnostics type ITrampolineInvocation = abstract member MoveNext: unit -> unit @@ -78,25 +79,33 @@ type ExecutionState = [] type Trampoline() = + let mutable bindDepth = 0 + static let current = new ThreadLocal<_>(fun () -> Trampoline()) let stack = System.Collections.Generic.Stack() member val State: ExecutionState = Running with get, set + member _.BindDepth = bindDepth + member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) + [] member this.Execute(invocation) = this.State <- Running + bindDepth <- bindDepth + 1 stack.Push invocation - while stack.Count > 0 do + while not invocation.IsCompleted do stack.Peek().MoveNext() if stack.Peek().IsCompleted then stack.Pop() |> ignore + bindDepth <- bindDepth - 1 + static member Current = current.Value type ITrampolineInvocation<'T> = @@ -217,32 +226,40 @@ type CancellableBuilder() = if __useResumableCode then let mutable invocation = code.GetInvocation() - match __resumableEntry () with - | Some contID -> - sm.ResumptionPoint <- contID - Trampoline.Current.Set invocation - false - | None -> - if Trampoline.Current.State.IsRunning then - (invocation.Data |> continuation).Invoke(&sm) - else - true + if Trampoline.Current.BindDepth < 100 then + Trampoline.Current.Execute invocation + + not Trampoline.Current.State.IsRunning + || (invocation.Data |> continuation).Invoke(&sm) + else + match __resumableEntry () with + | Some contID -> + sm.ResumptionPoint <- contID + Trampoline.Current.Set invocation + false + | None -> + not Trampoline.Current.State.IsRunning + || (invocation.Data |> continuation).Invoke(&sm) else // Dynamic Bind. let mutable invocation = code.GetInvocation() - let cont = - CancellableResumptionFunc<'Data>(fun sm -> - if Trampoline.Current.State.IsRunning then - (invocation.Data |> continuation).Invoke(&sm) - else - true) + if Trampoline.Current.BindDepth < 100 then + Trampoline.Current.Execute invocation + + not Trampoline.Current.State.IsRunning + || (invocation.Data |> continuation).Invoke(&sm) + else + let cont = + CancellableResumptionFunc<'Data>(fun sm -> + not Trampoline.Current.State.IsRunning + || (invocation.Data |> continuation).Invoke(&sm)) - Trampoline.Current.Set invocation - sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false) + Trampoline.Current.Set invocation + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false) member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 434f7d1e718..28abf117b77 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -38,6 +38,8 @@ type internal ExecutionState = type internal Trampoline = member State: ExecutionState with get, set member Set: ITrampolineInvocation -> unit + member Execute: ITrampolineInvocation -> unit + member BindDepth: int static member Current: Trampoline type internal ITrampolineInvocation<'T> = From 89b602485b192ed687338127e6fc98615d6fb6bc Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 10 Jul 2025 15:00:32 +0200 Subject: [PATCH 07/14] some helper funcs --- src/Compiler/Utilities/Cancellable.fs | 279 ++++++++++++++----------- src/Compiler/Utilities/Cancellable.fsi | 87 ++++---- 2 files changed, 202 insertions(+), 164 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 294ca18fb98..15f4b1b0933 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -69,32 +69,52 @@ type ITrampolineInvocation = abstract member MoveNext: unit -> unit abstract IsCompleted: bool -[] -type ExecutionState = - | Running - | Complete - | Cancelled of oce: OperationCanceledException - | Error of edi: ExceptionDispatchInfo +[] +type CancellableStateMachineData<'T> = + + [] + val mutable Result: 'T + +and CancellableStateMachine<'TOverall> = ResumableStateMachine> +and ICancellableStateMachine<'TOverall> = IResumableStateMachine> +and CancellableResumptionFunc<'TOverall> = ResumptionFunc> +and CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> +and CancellableCode<'TOverall, 'T> = ResumableCode, 'T> [] type Trampoline() = - let mutable bindDepth = 0 + [] + val mutable Token: CancellationToken - static let current = new ThreadLocal<_>(fun () -> Trampoline()) + [] + val mutable Exception: ExceptionDispatchInfo voption + + [] + val mutable BindDepth: int + + static let current = new ThreadLocal() let stack = System.Collections.Generic.Stack() - member val State: ExecutionState = Running with get, set + static member IsCancelled = current.Value.Token.IsCancellationRequested + static member HasError = current.Value.Exception.IsSome + + static member Good = + not (current.Value.Token.IsCancellationRequested || current.Value.Exception.IsSome) - member _.BindDepth = bindDepth + static member ThrowIfCancellationRequested() = + current.Value.Token.ThrowIfCancellationRequested() + + static member ShoudBounce = current.Value.BindDepth % 100 = 0 + + static member Install() = current.Value <- Trampoline() member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) [] member this.Execute(invocation) = - this.State <- Running - bindDepth <- bindDepth + 1 + this.BindDepth <- this.BindDepth + 1 stack.Push invocation @@ -104,23 +124,17 @@ type Trampoline() = if stack.Peek().IsCompleted then stack.Pop() |> ignore - bindDepth <- bindDepth - 1 + this.BindDepth <- this.BindDepth - 1 static member Current = current.Value type ITrampolineInvocation<'T> = inherit ITrampolineInvocation - abstract Data: 'T + abstract Result: 'T type IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> -type ICancellableStateMachine<'T> = IResumableStateMachine<'T> -type CancellableStateMachine<'T> = ResumableStateMachine<'T> -type CancellableResumptionFunc<'T> = ResumptionFunc<'T> -type CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo<'T> -type CancellableCode<'Data, 'T> = ResumableCode<'Data, 'T> - [] type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) = @@ -130,7 +144,7 @@ type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and interface ITrampolineInvocation<'T> with member _.MoveNext() = machine.MoveNext() member _.IsCompleted = machine.ResumptionPoint = -1 - member _.Data = machine.Data + member _.Result = machine.Data.Result interface IMachineTemplateWrapper<'T> with member _.Clone() = CancellableInvocation<_, _>(machine) @@ -140,82 +154,114 @@ type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = member _.GetInvocation() = template.Clone() -type CancellableBuilder() = +[] +module CancellableCode = - // Delay checks for cancellation and skips further steps when Cancelled / Errored. - member inline _.Delay(generator: unit -> CancellableCode<'Data, 'T>) = - CancellableCode<'Data, 'T>(fun sm -> - if Cancellable.Token.IsCancellationRequested then - Trampoline.Current.State <- Cancelled(OperationCanceledException Cancellable.Token) - - match Trampoline.Current.State with - | Running -> - try - (generator ()).Invoke(&sm) - with - | :? OperationCanceledException as oce when oce.CancellationToken = Cancellable.Token -> - Trampoline.Current.State <- Cancelled oce - true - | _exn -> - Trampoline.Current.State <- Error(ExceptionDispatchInfo.Capture _exn) - true - | _ -> true) - - member inline _.Zero() : CancellableCode<'Data, unit> = ResumableCode.Zero() - - member inline _.While(condition, body) : CancellableCode<'Data, unit> = - ResumableCode.While((fun () -> Trampoline.Current.State.IsRunning && condition ()), body) - - member inline this.For(sequence: seq<'T>, body: 'T -> CancellableCode<'Data, unit>) : CancellableCode<'Data, unit> = - // A for loop is just a using statement on the sequence's enumerator... - ResumableCode.Using( - sequence.GetEnumerator(), - // ... and its body is a while loop that advances the enumerator and runs the body on each element. - (fun e -> - this.While( - (fun () -> - __debugPoint "ForLoop.InOrToKeyword" - e.MoveNext()), - CancellableCode<'Data, unit>(fun sm -> (body e.Current).Invoke(&sm)) - )) - ) + let inline captureExn (exn: exn) = + match exn with + | :? OperationCanceledException as oce when oce.CancellationToken = Trampoline.Current.Token -> () + | exn -> Trampoline.Current.Exception <- ValueSome(ExceptionDispatchInfo.Capture exn) - member inline _.Combine(code1, code2) : CancellableCode<'Data, 'T> = ResumableCode.Combine(code1, code2) + Unchecked.defaultof<_> - member inline _.Using(resource, body) : CancellableCode<'Data, 'T> = ResumableCode.Using(resource, body) + let inline captureStackFrame () = + try + Trampoline.Current.Exception |> ValueOption.iter _.Throw() + with exn -> + Trampoline.Current.Exception <- ValueSome <| ExceptionDispatchInfo.Capture exn - member inline _.TryWith(body: CancellableCode<'Data, 'T>, catch: exn -> CancellableCode<'Data, 'T>) : CancellableCode<'Data, 'T> = + let inline protect (code: CancellableCode<_, _>) = CancellableCode(fun sm -> - let __stack_body_fin = body.Invoke(&sm) - - match Trampoline.Current.State with - | Error edi when __stack_body_fin -> - try - Trampoline.Current.State <- Running - (catch edi.SourceException).Invoke(&sm) - with - // Unhandled, restore state. - | exn when exn = edi.SourceException -> - Trampoline.Current.State <- Error edi - true - // Exception in handler. - | _newExn -> - Trampoline.Current.State <- Error(ExceptionDispatchInfo.Capture _newExn) - true - | _ -> __stack_body_fin) - - member inline _.TryFinally(body: CancellableCode<'Data, 'T>, compensation) : CancellableCode<'Data, 'T> = + try + code.Invoke(&sm) + with exn -> + captureExn exn + true) + + let inline notWhenCancelled (code: CancellableCode<_, _>) = + CancellableCode(fun sm -> Trampoline.IsCancelled || (protect code).Invoke(&sm)) + + let inline notWhenError (code: CancellableCode<_, _>) = + CancellableCode(fun sm -> Trampoline.HasError || (protect code).Invoke(&sm)) + + let inline whenGood (code: CancellableCode<_, _>) = + CancellableCode(fun sm -> Trampoline.HasError || Trampoline.IsCancelled || (protect code).Invoke(&sm)) + + let inline whenGoodApply (code: _ -> CancellableCode<_, _>) arg = + CancellableCode(fun sm -> + Trampoline.HasError + || Trampoline.IsCancelled + || (code arg |> protect).Invoke(&sm)) + + let inline throwIfCancellationRequested (code: CancellableCode<_, _>) = + CancellableCode(fun sm -> + Trampoline.Current.Token.ThrowIfCancellationRequested() + code.Invoke(&sm)) + +type CancellableBuilder() = + + member inline _.Delay(generator: unit -> CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = + ResumableCode.Delay(generator) |> protect + + /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. + [] + member inline _.Zero() : CancellableCode<'TOverall, unit> = ResumableCode.Zero() + + member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = + CancellableCode<'T, _>(fun sm -> + sm.Data.Result <- value + true) + + /// Chains together a step with its following step. + /// Note that this requires that the first step has no result. + /// This prevents constructs like `task { return 1; return 2; }`. + member inline _.Combine + (code1: CancellableCode<'TOverall, unit>, code2: CancellableCode<'TOverall, 'T>) + : CancellableCode<'TOverall, 'T> = + ResumableCode.Combine(notWhenCancelled code1, whenGood code2) |> protect + + /// Builds a step that executes the body while the condition predicate is true. + member inline _.While + ([] condition: unit -> bool, body: CancellableCode<'TOverall, unit>) + : CancellableCode<'TOverall, unit> = + ResumableCode.While(condition, throwIfCancellationRequested body) |> protect + + /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function + /// to retrieve the step, and in the continuation of the step (if any). + member inline _.TryWith(body: CancellableCode<'TOverall, 'T>, catch: exn -> CancellableCode<'TOverall, 'T>) = + CancellableCode<'TOverall, 'T>(fun sm -> + let mutable __stack_fin = true + let __stack_body_fin = (protect body).Invoke(&sm) + __stack_fin <- __stack_body_fin + + if __stack_fin && Trampoline.HasError then + let __stack_filtered_exn = Trampoline.Current.Exception.Value.SourceException + // Clear for now, will get restored if not handled. + Trampoline.Current.Exception <- ValueNone + __stack_fin <- (catch __stack_filtered_exn |> protect |> notWhenCancelled).Invoke(&sm) + + __stack_fin) + + /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function + /// to retrieve the step, and in the continuation of the step (if any). + member inline _.TryFinally + (body: CancellableCode<'TOverall, 'T>, [] compensation: unit -> unit) + : CancellableCode<'TOverall, 'T> = ResumableCode.TryFinally( body, - ResumableCode(fun _sm -> + ResumableCode<_, _>(fun _sm -> compensation () true) ) - member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = - CancellableCode(fun sm -> - sm.Data <- value - true) + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable | null> + (resource: 'Resource, body: 'Resource -> CancellableCode<'TOverall, 'T>) + : CancellableCode<'TOverall, 'T> = + ResumableCode.Using(resource, whenGoodApply body) |> protect + + member inline _.For(sequence: seq<'T>, body: 'T -> CancellableCode<'TOverall, unit>) : CancellableCode<'TOverall, unit> = + ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) + |> protect member inline this.Yield(value) = this.Return(value) @@ -226,52 +272,45 @@ type CancellableBuilder() = if __useResumableCode then let mutable invocation = code.GetInvocation() - if Trampoline.Current.BindDepth < 100 then - Trampoline.Current.Execute invocation - - not Trampoline.Current.State.IsRunning - || (invocation.Data |> continuation).Invoke(&sm) - else + if Trampoline.ShoudBounce then match __resumableEntry () with | Some contID -> sm.ResumptionPoint <- contID Trampoline.Current.Set invocation false - | None -> - not Trampoline.Current.State.IsRunning - || (invocation.Data |> continuation).Invoke(&sm) + | None -> (invocation.Result |> continuation |> whenGood).Invoke(&sm) + else + Trampoline.Current.Execute invocation + (invocation.Result |> continuation |> whenGood).Invoke(&sm) else // Dynamic Bind. let mutable invocation = code.GetInvocation() - if Trampoline.Current.BindDepth < 100 then - Trampoline.Current.Execute invocation - - not Trampoline.Current.State.IsRunning - || (invocation.Data |> continuation).Invoke(&sm) - else + if Trampoline.ShoudBounce then let cont = - CancellableResumptionFunc<'Data>(fun sm -> - not Trampoline.Current.State.IsRunning - || (invocation.Data |> continuation).Invoke(&sm)) + CancellableResumptionFunc<'Data>(fun sm -> (whenGoodApply continuation invocation.Result).Invoke(&sm)) Trampoline.Current.Set invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false) + false + else + Trampoline.Current.Execute invocation + (whenGoodApply continuation invocation.Result).Invoke(&sm)) member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) member inline _.Run(code: CancellableCode<'T, 'T>) : Cancellable<'T> = if __useResumableCode then - __stateMachine<'T, Cancellable<'T>> + __stateMachine<_, _> (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint - let __stack_code_fin = code.Invoke(&sm) + let __stack_code_fin = (protect code).Invoke(&sm) if __stack_code_fin then + captureStackFrame () sm.ResumptionPoint <- -1)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -280,12 +319,14 @@ type CancellableBuilder() = else // Dynamic Run. - let initialResumptionFunc = CancellableResumptionFunc(fun sm -> code.Invoke(&sm)) + let initialResumptionFunc = + CancellableResumptionFunc(fun sm -> (protect code).Invoke(&sm)) let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = if info.ResumptionFunc.Invoke(&sm) then + captureStackFrame () sm.ResumptionPoint <- -1 member _.SetStateMachine(_, _) = () @@ -314,18 +355,20 @@ module Cancellable = use _ = FSharp.Compiler.Cancellable.UsingToken ct let invocation = code.GetInvocation() + Trampoline.Install() Trampoline.Current.Execute invocation invocation let runWithoutCancellation code = let invocation = run CancellationToken.None code - match Trampoline.Current.State with - | Error edi -> - edi.Throw() + if Trampoline.IsCancelled then + raise (OperationCanceledException Trampoline.Current.Token) + elif Trampoline.HasError then + Trampoline.Current.Exception.Value.Throw() Unchecked.defaultof<_> - | Cancelled _ -> failwith "Unexpected cancel in runWithoutCancellation." - | _ -> invocation.Data + else + invocation.Result let toAsync (code: Cancellable<_>) = async { @@ -335,10 +378,12 @@ module Cancellable = Async.FromContinuations(fun (cont, econt, ccont) -> let invocation = run ct code - match Trampoline.Current.State with - | Cancelled oce -> ccont oce - | Error edi -> econt edi.SourceException - | _ -> cont invocation.Data) + if Trampoline.IsCancelled then + ccont (OperationCanceledException Trampoline.Current.Token) + elif Trampoline.HasError then + econt Trampoline.Current.Exception.Value.SourceException + else + cont invocation.Result) } let token () = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 28abf117b77..a29b0fdba75 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -6,10 +6,9 @@ open System.Threading [] type Cancellable = static member internal UseToken: unit -> Async - + static member internal UsingToken: CancellationToken -> IDisposable static member HasCancellationToken: bool static member Token: CancellationToken - static member CheckAndThrow: unit -> unit static member TryCheckAndThrow: unit -> unit @@ -22,61 +21,53 @@ open System.Runtime.CompilerServices open System.Runtime.ExceptionServices type internal ITrampolineInvocation = - abstract MoveNext: unit -> unit - abstract IsCompleted: bool -[] -type internal ExecutionState = - | Running - | Complete - | Cancelled of oce: OperationCanceledException - | Error of edi: ExceptionDispatchInfo +[] +type internal CancellableStateMachineData<'T> = + val mutable Result: 'T -[] -type internal Trampoline = - member State: ExecutionState with get, set - member Set: ITrampolineInvocation -> unit - member Execute: ITrampolineInvocation -> unit - member BindDepth: int - static member Current: Trampoline +and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> +and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> +and internal CancellableResumptionFunc<'TOverall> = ResumptionFunc> +and internal CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> +and internal CancellableCode<'TOverall, 'T> = ResumableCode, 'T> type internal ITrampolineInvocation<'T> = inherit ITrampolineInvocation - - abstract Data: 'T + abstract Result: 'T type internal IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> -type internal ICancellableStateMachine<'T> = IResumableStateMachine<'T> - -type internal CancellableStateMachine<'T> = ResumableStateMachine<'T> - -type internal CancellableResumptionFunc<'T> = ResumptionFunc<'T> - -type internal CancellableResumptionDynamicInfo<'T> = ResumptionDynamicInfo<'T> - -type internal CancellableCode<'Data, 'T> = ResumableCode<'Data, 'T> +[] +type internal Trampoline = + val mutable Token: CancellationToken + val mutable Exception: ExceptionDispatchInfo voption + val mutable BindDepth: int + member Set: ITrampolineInvocation -> unit + member Execute: ITrampolineInvocation -> unit + static member Current: Trampoline + static member IsCancelled: bool + static member HasError: bool + static member Good: bool + static member ThrowIfCancellationRequested: unit -> unit + static member ShoudBounce: bool [] type internal CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> = interface IMachineTemplateWrapper<'T> interface ITrampolineInvocation<'T> - new: machine: 'Machine -> CancellableInvocation<'T, 'Machine> -[] +[] type internal Cancellable<'T> = - new: template: IMachineTemplateWrapper<'T> -> Cancellable<'T> - member GetInvocation: unit -> ITrampolineInvocation<'T> type internal CancellableBuilder = - new: unit -> CancellableBuilder member inline Bind: @@ -87,13 +78,9 @@ type internal CancellableBuilder = code1: CancellableCode<'Data, unit> * code2: CancellableCode<'Data, 'T> -> CancellableCode<'Data, 'T> member inline Delay: generator: (unit -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> - member inline For: sequence: 'e seq * body: ('e -> CancellableCode<'Data, unit>) -> CancellableCode<'Data, unit> - member inline Return: value: 'T -> CancellableCode<'T, 'T> - member inline ReturnFrom: comp: Cancellable<'T> -> CancellableCode<'T, 'T> - member inline Run: code: CancellableCode<'T, 'T> -> Cancellable<'T> member inline TryFinally: @@ -102,31 +89,37 @@ type internal CancellableBuilder = member inline TryWith: body: CancellableCode<'Data, 'T> * catch: (exn -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> - member inline Using: - resource: 'b * body: ('b -> CancellableCode<'Data, 'T>) -> CancellableCode<'Data, 'T> - when 'b :> IDisposable | null - member inline While: condition: (unit -> bool) * body: CancellableCode<'Data, unit> -> CancellableCode<'Data, unit> - member inline Yield: value: 'a -> CancellableCode<'a, 'a> - member inline Zero: unit -> CancellableCode<'Data, unit> + member inline Using: + resource: 'Resource * body: ('Resource -> CancellableCode<'TOverall, 'T>) -> CancellableCode<'TOverall, 'T> + when 'Resource :> IDisposable | null + +[] +module internal CancellableCode = + val inline captureExn: exn -> 'a + val inline captureStackFrame: unit -> unit + val inline protect: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> + val inline notWhenCancelled: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> + val inline notWhenError: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> + val inline whenGood: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> + val inline throwIfCancellationRequested: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> + namespace Internal.Utilities.Library open System.Threading +open Internal.Utilities.Library.CancellableImplementation type internal Cancellable<'T> = CancellableImplementation.Cancellable<'T> [] module internal CancellableAutoOpens = - val cancellable: CancellableImplementation.CancellableBuilder module internal Cancellable = - + val run: ct: CancellationToken -> code: Cancellable<'a> -> ITrampolineInvocation<'a> val runWithoutCancellation: code: Cancellable<'a> -> 'a - val toAsync: code: Cancellable<'a> -> Async<'a> - val token: unit -> Cancellable From 9016fe2b3beb67a097b072fd483c32d190786497 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 10 Jul 2025 18:19:17 +0200 Subject: [PATCH 08/14] just cut deep stack traces short judiciously --- src/Compiler/Utilities/Cancellable.fs | 187 +++++++++++-------------- src/Compiler/Utilities/Cancellable.fsi | 23 +-- 2 files changed, 88 insertions(+), 122 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 15f4b1b0933..c336eaea604 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -56,7 +56,6 @@ namespace Internal.Utilities.Library.CancellableImplementation open System open System.Threading -open FSharp.Compiler open FSharp.Core.CompilerServices.StateMachineHelpers @@ -73,7 +72,7 @@ type ITrampolineInvocation = type CancellableStateMachineData<'T> = [] - val mutable Result: 'T + val mutable Result: Result<'T, exn> and CancellableStateMachine<'TOverall> = ResumableStateMachine> and ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -82,39 +81,52 @@ and CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo = ResumableCode, 'T> [] -type Trampoline() = - - [] - val mutable Token: CancellationToken - - [] - val mutable Exception: ExceptionDispatchInfo voption +type Trampoline(cancellationToken: CancellationToken) = + let mutable bindDepth = 0 + let mutable storedException: ExceptionDispatchInfo voption = ValueNone + let mutable capturedFramesCount = 0 + + let captureStackFrame exn = + match storedException with + | ValueSome edi when edi.SourceException = exn -> + try + edi.Throw() + Unchecked.defaultof<_> + with exn -> + capturedFramesCount <- capturedFramesCount + 1 + let edi = ExceptionDispatchInfo.Capture exn + storedException <- ValueSome edi + edi.SourceException + | _ -> + capturedFramesCount <- 1 + let edi = ExceptionDispatchInfo.Capture exn + storedException <- ValueSome edi + edi.SourceException - [] - val mutable BindDepth: int + let stack = System.Collections.Generic.Stack() static let current = new ThreadLocal() - let stack = System.Collections.Generic.Stack() - - static member IsCancelled = current.Value.Token.IsCancellationRequested - static member HasError = current.Value.Exception.IsSome + member this.IsCancelled = cancellationToken.IsCancellationRequested - static member Good = - not (current.Value.Token.IsCancellationRequested || current.Value.Exception.IsSome) + member this.ThrowIfCancellationRequested() = + cancellationToken.ThrowIfCancellationRequested() - static member ThrowIfCancellationRequested() = - current.Value.Token.ThrowIfCancellationRequested() + member this.ShoudBounce = bindDepth % 100 = 0 - static member ShoudBounce = current.Value.BindDepth % 100 = 0 + member this.CaptureStackFrame(exn) = + if not this.IsCancelled && (bindDepth < 100 || capturedFramesCount < 200) then + captureStackFrame exn + else + exn - static member Install() = current.Value <- Trampoline() + static member Install ct = current.Value <- Trampoline ct member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) [] member this.Execute(invocation) = - this.BindDepth <- this.BindDepth + 1 + bindDepth <- bindDepth + 1 stack.Push invocation @@ -124,13 +136,13 @@ type Trampoline() = if stack.Peek().IsCompleted then stack.Pop() |> ignore - this.BindDepth <- this.BindDepth - 1 + bindDepth <- bindDepth - 1 static member Current = current.Value type ITrampolineInvocation<'T> = inherit ITrampolineInvocation - abstract Result: 'T + abstract Result: Result<'T, exn> type IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> @@ -157,51 +169,27 @@ type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = [] module CancellableCode = - let inline captureExn (exn: exn) = - match exn with - | :? OperationCanceledException as oce when oce.CancellationToken = Trampoline.Current.Token -> () - | exn -> Trampoline.Current.Exception <- ValueSome(ExceptionDispatchInfo.Capture exn) - - Unchecked.defaultof<_> - - let inline captureStackFrame () = - try - Trampoline.Current.Exception |> ValueOption.iter _.Throw() - with exn -> - Trampoline.Current.Exception <- ValueSome <| ExceptionDispatchInfo.Capture exn - - let inline protect (code: CancellableCode<_, _>) = + let inline filterCancellation (catch: exn -> CancellableCode<_, _>) exn = CancellableCode(fun sm -> try - code.Invoke(&sm) - with exn -> - captureExn exn + (catch exn).Invoke(&sm) + with :? OperationCanceledException when Trampoline.Current.IsCancelled -> true) - let inline notWhenCancelled (code: CancellableCode<_, _>) = - CancellableCode(fun sm -> Trampoline.IsCancelled || (protect code).Invoke(&sm)) - - let inline notWhenError (code: CancellableCode<_, _>) = - CancellableCode(fun sm -> Trampoline.HasError || (protect code).Invoke(&sm)) - - let inline whenGood (code: CancellableCode<_, _>) = - CancellableCode(fun sm -> Trampoline.HasError || Trampoline.IsCancelled || (protect code).Invoke(&sm)) - - let inline whenGoodApply (code: _ -> CancellableCode<_, _>) arg = - CancellableCode(fun sm -> - Trampoline.HasError - || Trampoline.IsCancelled - || (code arg |> protect).Invoke(&sm)) - let inline throwIfCancellationRequested (code: CancellableCode<_, _>) = CancellableCode(fun sm -> - Trampoline.Current.Token.ThrowIfCancellationRequested() + Trampoline.Current.ThrowIfCancellationRequested() code.Invoke(&sm)) + let inline getResult (invocation: ITrampolineInvocation<_>) = + match invocation.Result with + | Ok value -> value + | Error exn -> raise exn + type CancellableBuilder() = member inline _.Delay(generator: unit -> CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = - ResumableCode.Delay(generator) |> protect + ResumableCode.Delay(fun () -> generator () |> throwIfCancellationRequested) /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. [] @@ -209,7 +197,7 @@ type CancellableBuilder() = member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode<'T, _>(fun sm -> - sm.Data.Result <- value + sm.Data.Result <- Ok value true) /// Chains together a step with its following step. @@ -218,29 +206,20 @@ type CancellableBuilder() = member inline _.Combine (code1: CancellableCode<'TOverall, unit>, code2: CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = - ResumableCode.Combine(notWhenCancelled code1, whenGood code2) |> protect + ResumableCode.Combine(code1, code2) /// Builds a step that executes the body while the condition predicate is true. member inline _.While ([] condition: unit -> bool, body: CancellableCode<'TOverall, unit>) : CancellableCode<'TOverall, unit> = - ResumableCode.While(condition, throwIfCancellationRequested body) |> protect + ResumableCode.While(condition, throwIfCancellationRequested body) /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryWith(body: CancellableCode<'TOverall, 'T>, catch: exn -> CancellableCode<'TOverall, 'T>) = - CancellableCode<'TOverall, 'T>(fun sm -> - let mutable __stack_fin = true - let __stack_body_fin = (protect body).Invoke(&sm) - __stack_fin <- __stack_body_fin - - if __stack_fin && Trampoline.HasError then - let __stack_filtered_exn = Trampoline.Current.Exception.Value.SourceException - // Clear for now, will get restored if not handled. - Trampoline.Current.Exception <- ValueNone - __stack_fin <- (catch __stack_filtered_exn |> protect |> notWhenCancelled).Invoke(&sm) - - __stack_fin) + member inline _.TryWith + (body: CancellableCode<'TOverall, 'T>, catch: exn -> CancellableCode<'TOverall, 'T>) + : CancellableCode<'TOverall, 'T> = + ResumableCode.TryWith(body, filterCancellation catch) /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function /// to retrieve the step, and in the continuation of the step (if any). @@ -257,11 +236,10 @@ type CancellableBuilder() = member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable | null> (resource: 'Resource, body: 'Resource -> CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = - ResumableCode.Using(resource, whenGoodApply body) |> protect + ResumableCode.Using(resource, body) member inline _.For(sequence: seq<'T>, body: 'T -> CancellableCode<'TOverall, unit>) : CancellableCode<'TOverall, unit> = ResumableCode.For(sequence, fun x -> body x |> throwIfCancellationRequested) - |> protect member inline this.Yield(value) = this.Return(value) @@ -272,32 +250,32 @@ type CancellableBuilder() = if __useResumableCode then let mutable invocation = code.GetInvocation() - if Trampoline.ShoudBounce then + if Trampoline.Current.ShoudBounce then match __resumableEntry () with | Some contID -> sm.ResumptionPoint <- contID Trampoline.Current.Set invocation false - | None -> (invocation.Result |> continuation |> whenGood).Invoke(&sm) + | None -> (invocation |> getResult |> continuation).Invoke(&sm) else Trampoline.Current.Execute invocation - (invocation.Result |> continuation |> whenGood).Invoke(&sm) + (invocation |> getResult |> continuation).Invoke(&sm) else // Dynamic Bind. let mutable invocation = code.GetInvocation() - if Trampoline.ShoudBounce then + if Trampoline.Current.ShoudBounce then let cont = - CancellableResumptionFunc<'Data>(fun sm -> (whenGoodApply continuation invocation.Result).Invoke(&sm)) + CancellableResumptionFunc<'Data>(fun sm -> (invocation |> getResult |> continuation).Invoke(&sm)) Trampoline.Current.Set invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont false else Trampoline.Current.Execute invocation - (whenGoodApply continuation invocation.Result).Invoke(&sm)) + (invocation |> getResult |> continuation).Invoke(&sm)) member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) @@ -307,10 +285,14 @@ type CancellableBuilder() = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint - let __stack_code_fin = (protect code).Invoke(&sm) - if __stack_code_fin then - captureStackFrame () + try + let __stack_code_fin = code.Invoke(&sm) + + if __stack_code_fin then + sm.ResumptionPoint <- -1 + with exn -> + sm.Data.Result <- Error <| Trampoline.Current.CaptureStackFrame exn sm.ResumptionPoint <- -1)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -319,14 +301,16 @@ type CancellableBuilder() = else // Dynamic Run. - let initialResumptionFunc = - CancellableResumptionFunc(fun sm -> (protect code).Invoke(&sm)) + let initialResumptionFunc = CancellableResumptionFunc(fun sm -> code.Invoke(&sm)) let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = - if info.ResumptionFunc.Invoke(&sm) then - captureStackFrame () + try + if info.ResumptionFunc.Invoke(&sm) then + sm.ResumptionPoint <- -1 + with exn -> + sm.Data.Result <- Error <| Trampoline.Current.CaptureStackFrame exn sm.ResumptionPoint <- -1 member _.SetStateMachine(_, _) = () @@ -355,35 +339,28 @@ module Cancellable = use _ = FSharp.Compiler.Cancellable.UsingToken ct let invocation = code.GetInvocation() - Trampoline.Install() + Trampoline.Install ct Trampoline.Current.Execute invocation invocation let runWithoutCancellation code = let invocation = run CancellationToken.None code - if Trampoline.IsCancelled then - raise (OperationCanceledException Trampoline.Current.Token) - elif Trampoline.HasError then - Trampoline.Current.Exception.Value.Throw() - Unchecked.defaultof<_> + if Trampoline.Current.IsCancelled then + failwith "Unexpected cancellation in Cancellable.runWithoutCancellation" else - invocation.Result + getResult invocation - let toAsync (code: Cancellable<_>) = + let toAsync code = async { let! ct = Async.CancellationToken return! Async.FromContinuations(fun (cont, econt, ccont) -> - let invocation = run ct code - - if Trampoline.IsCancelled then - ccont (OperationCanceledException Trampoline.Current.Token) - elif Trampoline.HasError then - econt Trampoline.Current.Exception.Value.SourceException - else - cont invocation.Result) + match run ct code |> _.Result with + | _ when Trampoline.Current.IsCancelled -> ccont (OperationCanceledException ct) + | Ok value -> cont value + | Error exn -> econt exn) } let token () = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index a29b0fdba75..ed1142edfe6 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -18,7 +18,6 @@ open System open System.Threading open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices -open System.Runtime.ExceptionServices type internal ITrampolineInvocation = abstract MoveNext: unit -> unit @@ -26,7 +25,7 @@ type internal ITrampolineInvocation = [] type internal CancellableStateMachineData<'T> = - val mutable Result: 'T + val mutable Result: Result<'T, exn> and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -36,24 +35,20 @@ and internal CancellableCode<'TOverall, 'T> = ResumableCode = inherit ITrampolineInvocation - abstract Result: 'T + abstract Result: Result<'T, exn> type internal IMachineTemplateWrapper<'T> = abstract Clone: unit -> ITrampolineInvocation<'T> [] type internal Trampoline = - val mutable Token: CancellationToken - val mutable Exception: ExceptionDispatchInfo voption - val mutable BindDepth: int member Set: ITrampolineInvocation -> unit member Execute: ITrampolineInvocation -> unit static member Current: Trampoline - static member IsCancelled: bool - static member HasError: bool - static member Good: bool - static member ThrowIfCancellationRequested: unit -> unit - static member ShoudBounce: bool + member IsCancelled: bool + member ThrowIfCancellationRequested: unit -> unit + member ShoudBounce: bool + member CaptureStackFrame: exn -> exn [] type internal CancellableInvocation<'T, 'Machine @@ -99,12 +94,6 @@ type internal CancellableBuilder = [] module internal CancellableCode = - val inline captureExn: exn -> 'a - val inline captureStackFrame: unit -> unit - val inline protect: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> - val inline notWhenCancelled: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> - val inline notWhenError: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> - val inline whenGood: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> val inline throwIfCancellationRequested: CancellableCode<'a, 'b> -> CancellableCode<'a, 'c> namespace Internal.Utilities.Library From 0a25a60c73037086d887e0656f5c3262acd468a7 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 10 Jul 2025 21:43:27 +0200 Subject: [PATCH 09/14] just let unhandled exns pass through --- src/Compiler/Utilities/Cancellable.fs | 99 ++++++-------------------- src/Compiler/Utilities/Cancellable.fsi | 13 ++-- 2 files changed, 27 insertions(+), 85 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index c336eaea604..49234d8024f 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -72,7 +72,7 @@ type ITrampolineInvocation = type CancellableStateMachineData<'T> = [] - val mutable Result: Result<'T, exn> + val mutable Result: 'T and CancellableStateMachine<'TOverall> = ResumableStateMachine> and ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -83,27 +83,8 @@ and CancellableCode<'TOverall, 'T> = ResumableCode] type Trampoline(cancellationToken: CancellationToken) = let mutable bindDepth = 0 - let mutable storedException: ExceptionDispatchInfo voption = ValueNone - let mutable capturedFramesCount = 0 - let captureStackFrame exn = - match storedException with - | ValueSome edi when edi.SourceException = exn -> - try - edi.Throw() - Unchecked.defaultof<_> - with exn -> - capturedFramesCount <- capturedFramesCount + 1 - let edi = ExceptionDispatchInfo.Capture exn - storedException <- ValueSome edi - edi.SourceException - | _ -> - capturedFramesCount <- 1 - let edi = ExceptionDispatchInfo.Capture exn - storedException <- ValueSome edi - edi.SourceException - - let stack = System.Collections.Generic.Stack() + let stack = Collections.Generic.Stack() static let current = new ThreadLocal() @@ -114,15 +95,9 @@ type Trampoline(cancellationToken: CancellationToken) = member this.ShoudBounce = bindDepth % 100 = 0 - member this.CaptureStackFrame(exn) = - if not this.IsCancelled && (bindDepth < 100 || capturedFramesCount < 200) then - captureStackFrame exn - else - exn - static member Install ct = current.Value <- Trampoline ct - member _.Set(invocation: ITrampolineInvocation) = stack.Push(invocation) + member _.Set(invocation) = stack.Push(invocation) [] member this.Execute(invocation) = @@ -142,10 +117,10 @@ type Trampoline(cancellationToken: CancellationToken) = type ITrampolineInvocation<'T> = inherit ITrampolineInvocation - abstract Result: Result<'T, exn> + abstract Result: 'T -type IMachineTemplateWrapper<'T> = - abstract Clone: unit -> ITrampolineInvocation<'T> +type ICancellableInvokable<'T> = + abstract Create: unit -> ITrampolineInvocation<'T> [] type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) @@ -158,13 +133,13 @@ type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and member _.IsCompleted = machine.ResumptionPoint = -1 member _.Result = machine.Data.Result - interface IMachineTemplateWrapper<'T> with - member _.Clone() = CancellableInvocation<_, _>(machine) + interface ICancellableInvokable<'T> with + member _.Create() = CancellableInvocation<_, _>(machine) [] -type Cancellable<'T>(template: IMachineTemplateWrapper<'T>) = +type Cancellable<'T>(invokable: ICancellableInvokable<'T>) = - member _.GetInvocation() = template.Clone() + member _.GetInvocation() = invokable.Create() [] module CancellableCode = @@ -181,48 +156,34 @@ module CancellableCode = Trampoline.Current.ThrowIfCancellationRequested() code.Invoke(&sm)) - let inline getResult (invocation: ITrampolineInvocation<_>) = - match invocation.Result with - | Ok value -> value - | Error exn -> raise exn - type CancellableBuilder() = member inline _.Delay(generator: unit -> CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = ResumableCode.Delay(fun () -> generator () |> throwIfCancellationRequested) - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. [] member inline _.Zero() : CancellableCode<'TOverall, unit> = ResumableCode.Zero() member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode<'T, _>(fun sm -> - sm.Data.Result <- Ok value + sm.Data.Result <- value true) - /// Chains together a step with its following step. - /// Note that this requires that the first step has no result. - /// This prevents constructs like `task { return 1; return 2; }`. member inline _.Combine (code1: CancellableCode<'TOverall, unit>, code2: CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = ResumableCode.Combine(code1, code2) - /// Builds a step that executes the body while the condition predicate is true. member inline _.While ([] condition: unit -> bool, body: CancellableCode<'TOverall, unit>) : CancellableCode<'TOverall, unit> = ResumableCode.While(condition, throwIfCancellationRequested body) - /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). member inline _.TryWith (body: CancellableCode<'TOverall, 'T>, catch: exn -> CancellableCode<'TOverall, 'T>) : CancellableCode<'TOverall, 'T> = ResumableCode.TryWith(body, filterCancellation catch) - /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). member inline _.TryFinally (body: CancellableCode<'TOverall, 'T>, [] compensation: unit -> unit) : CancellableCode<'TOverall, 'T> = @@ -256,10 +217,10 @@ type CancellableBuilder() = sm.ResumptionPoint <- contID Trampoline.Current.Set invocation false - | None -> (invocation |> getResult |> continuation).Invoke(&sm) + | None -> (continuation invocation.Result).Invoke(&sm) else Trampoline.Current.Execute invocation - (invocation |> getResult |> continuation).Invoke(&sm) + (continuation invocation.Result).Invoke(&sm) else // Dynamic Bind. @@ -268,14 +229,15 @@ type CancellableBuilder() = if Trampoline.Current.ShoudBounce then let cont = - CancellableResumptionFunc<'Data>(fun sm -> (invocation |> getResult |> continuation).Invoke(&sm)) + CancellableResumptionFunc<'Data>(fun sm -> (continuation invocation.Result).Invoke(&sm)) Trampoline.Current.Set invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont false else Trampoline.Current.Execute invocation - (invocation |> getResult |> continuation).Invoke(&sm)) + (continuation invocation.Result).Invoke(&sm)) + |> throwIfCancellationRequested member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) @@ -285,14 +247,9 @@ type CancellableBuilder() = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint + let __stack_code_fin = code.Invoke(&sm) - try - let __stack_code_fin = code.Invoke(&sm) - - if __stack_code_fin then - sm.ResumptionPoint <- -1 - with exn -> - sm.Data.Result <- Error <| Trampoline.Current.CaptureStackFrame exn + if __stack_code_fin then sm.ResumptionPoint <- -1)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -306,11 +263,7 @@ type CancellableBuilder() = let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = - try - if info.ResumptionFunc.Invoke(&sm) then - sm.ResumptionPoint <- -1 - with exn -> - sm.Data.Result <- Error <| Trampoline.Current.CaptureStackFrame exn + if info.ResumptionFunc.Invoke(&sm) then sm.ResumptionPoint <- -1 member _.SetStateMachine(_, _) = () @@ -344,23 +297,13 @@ module Cancellable = invocation let runWithoutCancellation code = - let invocation = run CancellationToken.None code - - if Trampoline.Current.IsCancelled then - failwith "Unexpected cancellation in Cancellable.runWithoutCancellation" - else - getResult invocation + code |> run CancellationToken.None |> _.Result let toAsync code = async { let! ct = Async.CancellationToken - return! - Async.FromContinuations(fun (cont, econt, ccont) -> - match run ct code |> _.Result with - | _ when Trampoline.Current.IsCancelled -> ccont (OperationCanceledException ct) - | Ok value -> cont value - | Error exn -> econt exn) + return run ct code |> _.Result } let token () = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index ed1142edfe6..7a124eb1143 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -25,7 +25,7 @@ type internal ITrampolineInvocation = [] type internal CancellableStateMachineData<'T> = - val mutable Result: Result<'T, exn> + val mutable Result: 'T and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -35,10 +35,10 @@ and internal CancellableCode<'TOverall, 'T> = ResumableCode = inherit ITrampolineInvocation - abstract Result: Result<'T, exn> + abstract Result: 'T -type internal IMachineTemplateWrapper<'T> = - abstract Clone: unit -> ITrampolineInvocation<'T> +type internal ICancellableInvokable<'T> = + abstract Create: unit -> ITrampolineInvocation<'T> [] type internal Trampoline = @@ -48,18 +48,17 @@ type internal Trampoline = member IsCancelled: bool member ThrowIfCancellationRequested: unit -> unit member ShoudBounce: bool - member CaptureStackFrame: exn -> exn [] type internal CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> = - interface IMachineTemplateWrapper<'T> + interface ICancellableInvokable<'T> interface ITrampolineInvocation<'T> new: machine: 'Machine -> CancellableInvocation<'T, 'Machine> [] type internal Cancellable<'T> = - new: template: IMachineTemplateWrapper<'T> -> Cancellable<'T> + new: invokable: ICancellableInvokable<'T> -> Cancellable<'T> member GetInvocation: unit -> ITrampolineInvocation<'T> type internal CancellableBuilder = From b6ee38cea2b8b09da6dab72e1532bb9f171123f4 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 11 Jul 2025 23:34:41 +0200 Subject: [PATCH 10/14] revert some --- src/Compiler/Utilities/Cancellable.fs | 54 ++++++++++++++++++++------ src/Compiler/Utilities/Cancellable.fsi | 12 ++++-- 2 files changed, 51 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 49234d8024f..a40b44fed82 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -72,7 +72,7 @@ type ITrampolineInvocation = type CancellableStateMachineData<'T> = [] - val mutable Result: 'T + val mutable Result: Result<'T, ExceptionDispatchInfo> and CancellableStateMachine<'TOverall> = ResumableStateMachine> and ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -84,7 +84,7 @@ and CancellableCode<'TOverall, 'T> = ResumableCode() + let stack = System.Collections.Generic.Stack() static let current = new ThreadLocal() @@ -99,6 +99,8 @@ type Trampoline(cancellationToken: CancellationToken) = member _.Set(invocation) = stack.Push(invocation) + member val ExceptionMap = ConditionalWeakTable() + [] member this.Execute(invocation) = bindDepth <- bindDepth + 1 @@ -119,24 +121,44 @@ type ITrampolineInvocation<'T> = inherit ITrampolineInvocation abstract Result: 'T +[] +module ExceptionDispatchInfoHelpers = + type ExceptionDispatchInfo with + member edi.ThrowAny() = + edi.Throw() + Unchecked.defaultof<_> + + static member RestoreOrCapture(exn: exn) = + match Trampoline.Current.ExceptionMap.TryGetValue exn with + | true, edi -> edi + | _ -> + let edi = ExceptionDispatchInfo.Capture exn + Trampoline.Current.ExceptionMap.Add(exn, edi) + edi + +[] type ICancellableInvokable<'T> = abstract Create: unit -> ITrampolineInvocation<'T> [] type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) = - let mutable machine = machine interface ITrampolineInvocation<'T> with - member _.MoveNext() = machine.MoveNext() + member this.MoveNext() = machine.MoveNext() + + member _.Result = + match machine.Data.Result with + | Ok value -> value + | Error edi -> edi.ThrowAny() + member _.IsCompleted = machine.ResumptionPoint = -1 - member _.Result = machine.Data.Result interface ICancellableInvokable<'T> with member _.Create() = CancellableInvocation<_, _>(machine) -[] +[] type Cancellable<'T>(invokable: ICancellableInvokable<'T>) = member _.GetInvocation() = invokable.Create() @@ -166,7 +188,7 @@ type CancellableBuilder() = member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode<'T, _>(fun sm -> - sm.Data.Result <- value + sm.Data.Result <- Ok value true) member inline _.Combine @@ -237,7 +259,6 @@ type CancellableBuilder() = else Trampoline.Current.Execute invocation (continuation invocation.Result).Invoke(&sm)) - |> throwIfCancellationRequested member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) @@ -247,10 +268,15 @@ type CancellableBuilder() = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint - let __stack_code_fin = code.Invoke(&sm) - if __stack_code_fin then - sm.ResumptionPoint <- -1)) + try + let __stack_code_fin = code.Invoke(&sm) + + if __stack_code_fin then + sm.ResumptionPoint <- -1 + with exn -> + sm.ResumptionPoint <- -1 + sm.Data.Result <- Error <| ExceptionDispatchInfo.RestoreOrCapture exn)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -263,8 +289,12 @@ type CancellableBuilder() = let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = - if info.ResumptionFunc.Invoke(&sm) then + try + if info.ResumptionFunc.Invoke(&sm) then + sm.ResumptionPoint <- -1 + with exn -> sm.ResumptionPoint <- -1 + sm.Data.Result <- Error <| ExceptionDispatchInfo.RestoreOrCapture exn member _.SetStateMachine(_, _) = () } diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 7a124eb1143..6faecd60a36 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -15,9 +15,9 @@ type Cancellable = namespace Internal.Utilities.Library.CancellableImplementation open System -open System.Threading open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices +open System.Runtime.ExceptionServices type internal ITrampolineInvocation = abstract MoveNext: unit -> unit @@ -25,7 +25,7 @@ type internal ITrampolineInvocation = [] type internal CancellableStateMachineData<'T> = - val mutable Result: 'T + val mutable Result: Result<'T, ExceptionDispatchInfo> and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -56,11 +56,17 @@ type internal CancellableInvocation<'T, 'Machine interface ITrampolineInvocation<'T> new: machine: 'Machine -> CancellableInvocation<'T, 'Machine> -[] +[] type internal Cancellable<'T> = new: invokable: ICancellableInvokable<'T> -> Cancellable<'T> member GetInvocation: unit -> ITrampolineInvocation<'T> +[] +module internal ExceptionDispatchInfoHelpers = + type ExceptionDispatchInfo with + member ThrowAny: unit -> 'T + static member RestoreOrCapture: exn -> ExceptionDispatchInfo + type internal CancellableBuilder = new: unit -> CancellableBuilder From 11e632e3b96cea76cc202f4676c9f24716833b41 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 12 Jul 2025 17:41:37 +0200 Subject: [PATCH 11/14] pass exceptions correctly across trampoline bounces --- src/Compiler/Utilities/Cancellable.fs | 152 +++++++++++++++---------- src/Compiler/Utilities/Cancellable.fsi | 12 +- 2 files changed, 101 insertions(+), 63 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index a40b44fed82..9d4d6512aeb 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -67,12 +67,16 @@ open System.Diagnostics type ITrampolineInvocation = abstract member MoveNext: unit -> unit abstract IsCompleted: bool + abstract ReplayExceptionIfStored: unit -> unit [] type CancellableStateMachineData<'T> = [] - val mutable Result: Result<'T, ExceptionDispatchInfo> + val mutable Result: 'T + + [] + val mutable NextInvocation: ITrampolineInvocation voption and CancellableStateMachine<'TOverall> = ResumableStateMachine> and ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -82,38 +86,50 @@ and CancellableCode<'TOverall, 'T> = ResumableCode] type Trampoline(cancellationToken: CancellationToken) = + let mutable bindDepth = 0 - let stack = System.Collections.Generic.Stack() + [] + static let bindDepthLimit = 1000 static let current = new ThreadLocal() + let delayed = System.Collections.Generic.Stack() + member this.IsCancelled = cancellationToken.IsCancellationRequested member this.ThrowIfCancellationRequested() = cancellationToken.ThrowIfCancellationRequested() - member this.ShoudBounce = bindDepth % 100 = 0 + member this.ShoudBounce = + bindDepth % bindDepthLimit = 0 static member Install ct = current.Value <- Trampoline ct - member _.Set(invocation) = stack.Push(invocation) + member val LastError: ExceptionDispatchInfo voption = ValueNone with get, set - member val ExceptionMap = ConditionalWeakTable() + member this.RunDelayed(continuation, invocation) = + // The calling state machine is now suspended. We need to resume it next. + delayed.Push continuation + // Schedule the delayed invocation to run. + delayed.Push invocation - [] - member this.Execute(invocation) = + member this.RunImmediate(invocation: ITrampolineInvocation) = bindDepth <- bindDepth + 1 + try + // This can throw, which is fine. We want the exception to propagate to the calling machine. + invocation.MoveNext() - stack.Push invocation - - while not invocation.IsCompleted do - stack.Peek().MoveNext() - - if stack.Peek().IsCompleted then - stack.Pop() |> ignore + while not invocation.IsCompleted do + if delayed.Peek().IsCompleted then + delayed.Pop() |> ignore + else + delayed.Peek().MoveNext() + // In case this was a delayed invocation, which captures the exception, we need to replay it. + invocation.ReplayExceptionIfStored() + finally + bindDepth <- bindDepth - 1 - bindDepth <- bindDepth - 1 static member Current = current.Value @@ -124,45 +140,61 @@ type ITrampolineInvocation<'T> = [] module ExceptionDispatchInfoHelpers = type ExceptionDispatchInfo with - member edi.ThrowAny() = - edi.Throw() - Unchecked.defaultof<_> + member edi.ThrowAny() = edi.Throw(); Unchecked.defaultof<_> static member RestoreOrCapture(exn: exn) = - match Trampoline.Current.ExceptionMap.TryGetValue exn with - | true, edi -> edi + match Trampoline.Current.LastError with + | ValueSome edi when edi.SourceException = exn -> edi | _ -> let edi = ExceptionDispatchInfo.Capture exn - Trampoline.Current.ExceptionMap.Add(exn, edi) + Trampoline.Current.LastError <- ValueSome edi edi [] type ICancellableInvokable<'T> = - abstract Create: unit -> ITrampolineInvocation<'T> + abstract Create: bool -> ITrampolineInvocation<'T> [] -type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) +type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine, delayed: bool) = let mutable machine = machine + let mutable storedException = ValueNone + let mutable finished = false - interface ITrampolineInvocation<'T> with - member this.MoveNext() = machine.MoveNext() + new (machine) = CancellableInvocation(machine, false) - member _.Result = - match machine.Data.Result with - | Ok value -> value - | Error edi -> edi.ThrowAny() + interface ITrampolineInvocation<'T> with + member this.MoveNext() = + let pushDelayed () = + match machine.Data.NextInvocation with + | ValueSome delayed -> + Trampoline.Current.RunDelayed(this, delayed) + | _ -> finished <- true + + if delayed then + // If the invocation is delayed, we need to store the exception. + try + machine.MoveNext() + pushDelayed () + with exn -> + finished <- true + storedException <- ValueSome <| ExceptionDispatchInfo.RestoreOrCapture exn + else + machine.MoveNext() + pushDelayed () - member _.IsCompleted = machine.ResumptionPoint = -1 + member _.Result = machine.Data.Result + member _.IsCompleted = finished + member _.ReplayExceptionIfStored () = storedException |> ValueOption.iter _.Throw() interface ICancellableInvokable<'T> with - member _.Create() = CancellableInvocation<_, _>(machine) + member _.Create(delayed) = CancellableInvocation<_, _>(machine, delayed) -[] +[] type Cancellable<'T>(invokable: ICancellableInvokable<'T>) = - - member _.GetInvocation() = invokable.Create() - + + member _.GetInvocation(delayed) = invokable.Create(delayed) + [] module CancellableCode = @@ -188,7 +220,7 @@ type CancellableBuilder() = member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode<'T, _>(fun sm -> - sm.Data.Result <- Ok value + sm.Data.Result <- value true) member inline _.Combine @@ -231,33 +263,44 @@ type CancellableBuilder() = : CancellableCode<'Data, 'T> = CancellableCode(fun sm -> if __useResumableCode then - let mutable invocation = code.GetInvocation() + let mutable invocation = + code.GetInvocation Trampoline.Current.ShoudBounce if Trampoline.Current.ShoudBounce then + // Suspend this state machine and schedule both parts to run on the trampoline. match __resumableEntry () with + // Suspending | Some contID -> sm.ResumptionPoint <- contID - Trampoline.Current.Set invocation + sm.Data.NextInvocation <- ValueSome invocation false - | None -> (continuation invocation.Result).Invoke(&sm) + // Resuming + | None -> + sm.Data.NextInvocation <- ValueNone + // At this point we either have a result or an exception. + invocation.ReplayExceptionIfStored() + (continuation invocation.Result).Invoke(&sm) else - Trampoline.Current.Execute invocation + Trampoline.Current.RunImmediate invocation (continuation invocation.Result).Invoke(&sm) else // Dynamic Bind. - let mutable invocation = code.GetInvocation() + let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce if Trampoline.Current.ShoudBounce then let cont = - CancellableResumptionFunc<'Data>(fun sm -> (continuation invocation.Result).Invoke(&sm)) + CancellableResumptionFunc<'Data>(fun sm -> + sm.Data.NextInvocation <- ValueNone + invocation.ReplayExceptionIfStored() + (continuation invocation.Result).Invoke(&sm)) - Trampoline.Current.Set invocation + sm.Data.NextInvocation <- ValueSome invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont false else - Trampoline.Current.Execute invocation + Trampoline.Current.RunImmediate invocation (continuation invocation.Result).Invoke(&sm)) member inline this.ReturnFrom(comp: Cancellable<'T>) : CancellableCode<'T, 'T> = this.Bind(comp, this.Return) @@ -268,15 +311,11 @@ type CancellableBuilder() = (MoveNextMethodImpl<_>(fun sm -> __resumeAt sm.ResumptionPoint + let __stack_code_fin = code.Invoke(&sm) - try - let __stack_code_fin = code.Invoke(&sm) - - if __stack_code_fin then - sm.ResumptionPoint <- -1 - with exn -> + if __stack_code_fin then sm.ResumptionPoint <- -1 - sm.Data.Result <- Error <| ExceptionDispatchInfo.RestoreOrCapture exn)) + )) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -289,12 +328,8 @@ type CancellableBuilder() = let resumptionInfo = { new CancellableResumptionDynamicInfo<_>(initialResumptionFunc) with member info.MoveNext(sm) = - try - if info.ResumptionFunc.Invoke(&sm) then - sm.ResumptionPoint <- -1 - with exn -> + if info.ResumptionFunc.Invoke(&sm) then sm.ResumptionPoint <- -1 - sm.Data.Result <- Error <| ExceptionDispatchInfo.RestoreOrCapture exn member _.SetStateMachine(_, _) = () } @@ -303,6 +338,7 @@ type CancellableBuilder() = Cancellable(CancellableInvocation(sm)) + namespace Internal.Utilities.Library open System @@ -321,9 +357,9 @@ module Cancellable = let run ct (code: Cancellable<_>) = use _ = FSharp.Compiler.Cancellable.UsingToken ct - let invocation = code.GetInvocation() + let invocation = code.GetInvocation(false) Trampoline.Install ct - Trampoline.Current.Execute invocation + Trampoline.Current.RunImmediate invocation invocation let runWithoutCancellation code = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 6faecd60a36..0a88b549e72 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -22,10 +22,12 @@ open System.Runtime.ExceptionServices type internal ITrampolineInvocation = abstract MoveNext: unit -> unit abstract IsCompleted: bool + abstract ReplayExceptionIfStored: unit -> unit [] type internal CancellableStateMachineData<'T> = - val mutable Result: Result<'T, ExceptionDispatchInfo> + val mutable Result: 'T + val mutable NextInvocation: ITrampolineInvocation voption and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> @@ -38,12 +40,12 @@ type internal ITrampolineInvocation<'T> = abstract Result: 'T type internal ICancellableInvokable<'T> = - abstract Create: unit -> ITrampolineInvocation<'T> + abstract Create: bool -> ITrampolineInvocation<'T> [] type internal Trampoline = - member Set: ITrampolineInvocation -> unit - member Execute: ITrampolineInvocation -> unit + member RunDelayed: ITrampolineInvocation * ITrampolineInvocation -> unit + member RunImmediate: ITrampolineInvocation -> unit static member Current: Trampoline member IsCancelled: bool member ThrowIfCancellationRequested: unit -> unit @@ -59,7 +61,7 @@ type internal CancellableInvocation<'T, 'Machine [] type internal Cancellable<'T> = new: invokable: ICancellableInvokable<'T> -> Cancellable<'T> - member GetInvocation: unit -> ITrampolineInvocation<'T> + member GetInvocation: bool -> ITrampolineInvocation<'T> [] module internal ExceptionDispatchInfoHelpers = From ab0d07d4152e65884a3ec38908c5fcea5809e4f8 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 12 Jul 2025 19:18:35 +0200 Subject: [PATCH 12/14] format, limit --- src/Compiler/Utilities/Cancellable.fs | 40 +++++++++++++-------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 9d4d6512aeb..939b5b1b81f 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -90,7 +90,7 @@ type Trampoline(cancellationToken: CancellationToken) = let mutable bindDepth = 0 [] - static let bindDepthLimit = 1000 + static let bindDepthLimit = 100 static let current = new ThreadLocal() @@ -101,8 +101,7 @@ type Trampoline(cancellationToken: CancellationToken) = member this.ThrowIfCancellationRequested() = cancellationToken.ThrowIfCancellationRequested() - member this.ShoudBounce = - bindDepth % bindDepthLimit = 0 + member this.ShoudBounce = bindDepth % bindDepthLimit = 0 static member Install ct = current.Value <- Trampoline ct @@ -116,7 +115,8 @@ type Trampoline(cancellationToken: CancellationToken) = member this.RunImmediate(invocation: ITrampolineInvocation) = bindDepth <- bindDepth + 1 - try + + try // This can throw, which is fine. We want the exception to propagate to the calling machine. invocation.MoveNext() @@ -130,7 +130,6 @@ type Trampoline(cancellationToken: CancellationToken) = finally bindDepth <- bindDepth - 1 - static member Current = current.Value type ITrampolineInvocation<'T> = @@ -140,7 +139,9 @@ type ITrampolineInvocation<'T> = [] module ExceptionDispatchInfoHelpers = type ExceptionDispatchInfo with - member edi.ThrowAny() = edi.Throw(); Unchecked.defaultof<_> + member edi.ThrowAny() = + edi.Throw() + Unchecked.defaultof<_> static member RestoreOrCapture(exn: exn) = match Trampoline.Current.LastError with @@ -155,20 +156,19 @@ type ICancellableInvokable<'T> = abstract Create: bool -> ITrampolineInvocation<'T> [] -type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine, delayed: bool) - = +type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> + (machine: 'Machine, delayed: bool) = let mutable machine = machine let mutable storedException = ValueNone let mutable finished = false - new (machine) = CancellableInvocation(machine, false) + new(machine) = CancellableInvocation(machine, false) interface ITrampolineInvocation<'T> with member this.MoveNext() = let pushDelayed () = match machine.Data.NextInvocation with - | ValueSome delayed -> - Trampoline.Current.RunDelayed(this, delayed) + | ValueSome delayed -> Trampoline.Current.RunDelayed(this, delayed) | _ -> finished <- true if delayed then @@ -185,16 +185,19 @@ type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and member _.Result = machine.Data.Result member _.IsCompleted = finished - member _.ReplayExceptionIfStored () = storedException |> ValueOption.iter _.Throw() + + member _.ReplayExceptionIfStored() = + storedException |> ValueOption.iter _.Throw() interface ICancellableInvokable<'T> with - member _.Create(delayed) = CancellableInvocation<_, _>(machine, delayed) + member _.Create(delayed) = + CancellableInvocation<_, _>(machine, delayed) [] type Cancellable<'T>(invokable: ICancellableInvokable<'T>) = - + member _.GetInvocation(delayed) = invokable.Create(delayed) - + [] module CancellableCode = @@ -263,8 +266,7 @@ type CancellableBuilder() = : CancellableCode<'Data, 'T> = CancellableCode(fun sm -> if __useResumableCode then - let mutable invocation = - code.GetInvocation Trampoline.Current.ShoudBounce + let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce if Trampoline.Current.ShoudBounce then // Suspend this state machine and schedule both parts to run on the trampoline. @@ -314,8 +316,7 @@ type CancellableBuilder() = let __stack_code_fin = code.Invoke(&sm) if __stack_code_fin then - sm.ResumptionPoint <- -1 - )) + sm.ResumptionPoint <- -1)) (SetStateMachineMethodImpl<_>(fun _ _ -> ())) @@ -338,7 +339,6 @@ type CancellableBuilder() = Cancellable(CancellableInvocation(sm)) - namespace Internal.Utilities.Library open System From 258d1b5d387c9f63049c4e9767b13c60dea82ece Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 21 Jul 2025 15:15:38 +0200 Subject: [PATCH 13/14] simplify and speed up a bit --- src/Compiler/Checking/CheckDeclarations.fs | 8 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 23 +-- src/Compiler/Utilities/Cancellable.fs | 192 ++++++++----------- src/Compiler/Utilities/Cancellable.fsi | 39 ++-- 4 files changed, 105 insertions(+), 157 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7f943b5f305..a9d74633843 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1371,7 +1371,7 @@ module MutRecBindingChecking = let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m - with RecoverableException e -> + with e -> errorRecovery e m mkUnit g m, tpenv let envInstance = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envInstance | None -> envInstance @@ -5020,7 +5020,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE return env - with RecoverableException exn -> + with exn -> errorRecovery exn endm return env } @@ -5496,7 +5496,7 @@ 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 } @@ -5813,7 +5813,7 @@ let CheckOneImplFile for check in cenv.css.GetPostInferenceChecksPreDefaults() do try check() - with RecoverableException exn -> + with exn -> errorRecovery exn m conditionallySuppressErrorReporting (checkForErrors()) (fun () -> diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 1ef603a2a9e..5a15dad664c 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -882,22 +882,23 @@ type StackGuard(maxDepth: int, name: string) = [] line: int ) = - Activity.addEventWithTags - "DiagnosticsLogger.StackGuard.Guard" - (seq { - Activity.Tags.stackGuardName, box name - Activity.Tags.stackGuardCurrentDepth, depth - Activity.Tags.stackGuardMaxDepth, maxDepth - Activity.Tags.callerMemberName, memberName - Activity.Tags.callerFilePath, path - Activity.Tags.callerLineNumber, line - }) - depth <- depth + 1 try if depth % maxDepth = 0 then + use _ = + Activity.start + "DiagnosticsLogger.StackGuard.Guard" + (seq { + Activity.Tags.stackGuardName, name + Activity.Tags.stackGuardCurrentDepth, string depth + Activity.Tags.stackGuardMaxDepth, string maxDepth + Activity.Tags.callerMemberName, memberName + Activity.Tags.callerFilePath, path + Activity.Tags.callerLineNumber, string line + }) + async { do! Async.SwitchToNewThread() Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 939b5b1b81f..c8337a4fdff 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -65,24 +65,19 @@ open System.Runtime.ExceptionServices open System.Diagnostics type ITrampolineInvocation = - abstract member MoveNext: unit -> unit + abstract member MoveNext: unit -> bool abstract IsCompleted: bool - abstract ReplayExceptionIfStored: unit -> unit -[] -type CancellableStateMachineData<'T> = - - [] - val mutable Result: 'T +type internal CancellableStateMachine<'TOverall> = ResumableStateMachine<'TOverall> +type internal ICancellableStateMachine<'TOverall> = IResumableStateMachine<'TOverall> +type internal CancellableResumptionFunc<'TOverall> = ResumptionFunc<'TOverall> +type internal CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo<'TOverall> +type internal CancellableCode<'TOverall, 'T> = ResumableCode<'TOverall, 'T> - [] - val mutable NextInvocation: ITrampolineInvocation voption - -and CancellableStateMachine<'TOverall> = ResumableStateMachine> -and ICancellableStateMachine<'TOverall> = IResumableStateMachine> -and CancellableResumptionFunc<'TOverall> = ResumptionFunc> -and CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> -and CancellableCode<'TOverall, 'T> = ResumableCode, 'T> +[] +type PendingInvocation = + | Delayed of ITrampolineInvocation + | Immediate of ITrampolineInvocation [] type Trampoline(cancellationToken: CancellationToken) = @@ -92,9 +87,19 @@ type Trampoline(cancellationToken: CancellationToken) = [] static let bindDepthLimit = 100 - static let current = new ThreadLocal() + static let current = new AsyncLocal() - let delayed = System.Collections.Generic.Stack() + let pending = System.Collections.Generic.Stack<_>() + + let mutable lastError: ExceptionDispatchInfo voption = ValueNone + let mutable storedError: ExceptionDispatchInfo voption = ValueNone + + member _.ReplayException() = + match storedError with + | ValueSome edi -> + storedError <- ValueNone + edi.Throw() + | _ -> () member this.IsCancelled = cancellationToken.IsCancellationRequested @@ -103,110 +108,74 @@ type Trampoline(cancellationToken: CancellationToken) = member this.ShoudBounce = bindDepth % bindDepthLimit = 0 - static member Install ct = current.Value <- Trampoline ct + member this.SetDelayed(invocation) = pending.Push(Delayed invocation) - member val LastError: ExceptionDispatchInfo voption = ValueNone with get, set + member this.RunImmediate(invocation: ITrampolineInvocation) = + let captureException exn = + match lastError with + | ValueSome edi when edi.SourceException = exn -> () + | _ -> lastError <- ValueSome <| ExceptionDispatchInfo.Capture exn - member this.RunDelayed(continuation, invocation) = - // The calling state machine is now suspended. We need to resume it next. - delayed.Push continuation - // Schedule the delayed invocation to run. - delayed.Push invocation + storedError <- lastError - member this.RunImmediate(invocation: ITrampolineInvocation) = bindDepth <- bindDepth + 1 - try - // This can throw, which is fine. We want the exception to propagate to the calling machine. - invocation.MoveNext() + pending.Push(Immediate invocation) + try while not invocation.IsCompleted do - if delayed.Peek().IsCompleted then - delayed.Pop() |> ignore - else - delayed.Peek().MoveNext() - // In case this was a delayed invocation, which captures the exception, we need to replay it. - invocation.ReplayExceptionIfStored() + match pending.Peek() with + | Immediate i -> + if i.MoveNext() then + pending.Pop() |> ignore + | Delayed d -> + try + if d.MoveNext() then + pending.Pop() |> ignore + with exn -> + pending.Pop() |> ignore + captureException exn + + this.ReplayException() finally bindDepth <- bindDepth - 1 - static member Current = current.Value + static member Current = current.Value.Value + + static member Install ct = + current.Value <- ValueSome <| Trampoline ct type ITrampolineInvocation<'T> = inherit ITrampolineInvocation abstract Result: 'T -[] -module ExceptionDispatchInfoHelpers = - type ExceptionDispatchInfo with - member edi.ThrowAny() = - edi.Throw() - Unchecked.defaultof<_> - - static member RestoreOrCapture(exn: exn) = - match Trampoline.Current.LastError with - | ValueSome edi when edi.SourceException = exn -> edi - | _ -> - let edi = ExceptionDispatchInfo.Capture exn - Trampoline.Current.LastError <- ValueSome edi - edi - [] type ICancellableInvokable<'T> = - abstract Create: bool -> ITrampolineInvocation<'T> + abstract Create: unit -> ITrampolineInvocation<'T> [] -type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> - (machine: 'Machine, delayed: bool) = +type CancellableInvocation<'T, 'Machine + when 'Machine: struct and 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) = let mutable machine = machine - let mutable storedException = ValueNone - let mutable finished = false - - new(machine) = CancellableInvocation(machine, false) interface ITrampolineInvocation<'T> with - member this.MoveNext() = - let pushDelayed () = - match machine.Data.NextInvocation with - | ValueSome delayed -> Trampoline.Current.RunDelayed(this, delayed) - | _ -> finished <- true - - if delayed then - // If the invocation is delayed, we need to store the exception. - try - machine.MoveNext() - pushDelayed () - with exn -> - finished <- true - storedException <- ValueSome <| ExceptionDispatchInfo.RestoreOrCapture exn - else - machine.MoveNext() - pushDelayed () - - member _.Result = machine.Data.Result - member _.IsCompleted = finished - - member _.ReplayExceptionIfStored() = - storedException |> ValueOption.iter _.Throw() + member _.MoveNext() = + machine.MoveNext() + machine.ResumptionPoint = -1 - interface ICancellableInvokable<'T> with - member _.Create(delayed) = - CancellableInvocation<_, _>(machine, delayed) + member _.Result = machine.Data + member _.IsCompleted = machine.ResumptionPoint = -1 [] -type Cancellable<'T>(invokable: ICancellableInvokable<'T>) = +type Cancellable<'T>(clone: unit -> ITrampolineInvocation<'T>) = - member _.GetInvocation(delayed) = invokable.Create(delayed) + member _.GetInvocation() = clone () [] module CancellableCode = let inline filterCancellation (catch: exn -> CancellableCode<_, _>) exn = - CancellableCode(fun sm -> - try - (catch exn).Invoke(&sm) - with :? OperationCanceledException when Trampoline.Current.IsCancelled -> - true) + CancellableCode(fun sm -> Trampoline.Current.IsCancelled || (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: CancellableCode<_, _>) = CancellableCode(fun sm -> @@ -223,7 +192,7 @@ type CancellableBuilder() = member inline _.Return(value: 'T) : CancellableCode<'T, 'T> = CancellableCode<'T, _>(fun sm -> - sm.Data.Result <- value + sm.Data <- value true) member inline _.Combine @@ -266,7 +235,7 @@ type CancellableBuilder() = : CancellableCode<'Data, 'T> = CancellableCode(fun sm -> if __useResumableCode then - let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce + let mutable invocation = code.GetInvocation() if Trampoline.Current.ShoudBounce then // Suspend this state machine and schedule both parts to run on the trampoline. @@ -274,13 +243,11 @@ type CancellableBuilder() = // Suspending | Some contID -> sm.ResumptionPoint <- contID - sm.Data.NextInvocation <- ValueSome invocation + Trampoline.Current.SetDelayed invocation false // Resuming | None -> - sm.Data.NextInvocation <- ValueNone - // At this point we either have a result or an exception. - invocation.ReplayExceptionIfStored() + Trampoline.Current.ReplayException() (continuation invocation.Result).Invoke(&sm) else Trampoline.Current.RunImmediate invocation @@ -288,17 +255,15 @@ type CancellableBuilder() = else // Dynamic Bind. - - let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce + let mutable invocation = code.GetInvocation() if Trampoline.Current.ShoudBounce then let cont = CancellableResumptionFunc<'Data>(fun sm -> - sm.Data.NextInvocation <- ValueNone - invocation.ReplayExceptionIfStored() + Trampoline.Current.ReplayException() (continuation invocation.Result).Invoke(&sm)) - sm.Data.NextInvocation <- ValueSome invocation + Trampoline.Current.SetDelayed invocation sm.ResumptionDynamicInfo.ResumptionFunc <- cont false else @@ -320,7 +285,9 @@ type CancellableBuilder() = (SetStateMachineMethodImpl<_>(fun _ _ -> ())) - (AfterCode<_, _>(fun sm -> Cancellable(CancellableInvocation(sm)))) + (AfterCode<_, _>(fun sm -> + let copy = sm + Cancellable(fun () -> CancellableInvocation(copy)))) else // Dynamic Run. @@ -336,8 +303,7 @@ type CancellableBuilder() = } let sm = CancellableStateMachine(ResumptionDynamicInfo = resumptionInfo) - - Cancellable(CancellableInvocation(sm)) + Cancellable(fun () -> CancellableInvocation(sm)) namespace Internal.Utilities.Library @@ -354,22 +320,20 @@ module CancellableAutoOpens = module Cancellable = open Internal.Utilities.Library.CancellableImplementation - let run ct (code: Cancellable<_>) = - use _ = FSharp.Compiler.Cancellable.UsingToken ct - - let invocation = code.GetInvocation(false) - Trampoline.Install ct + let run (code: Cancellable<_>) = + let invocation = code.GetInvocation() + Trampoline.Install FSharp.Compiler.Cancellable.Token Trampoline.Current.RunImmediate invocation - invocation + invocation.Result let runWithoutCancellation code = - code |> run CancellationToken.None |> _.Result + use _ = FSharp.Compiler.Cancellable.UsingToken CancellationToken.None + run code let toAsync code = async { - let! ct = Async.CancellationToken - - return run ct code |> _.Result + use! _holder = FSharp.Compiler.Cancellable.UseToken() + return run code } let token () = diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 0a88b549e72..07e44740462 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -17,35 +17,26 @@ namespace Internal.Utilities.Library.CancellableImplementation open System open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices -open System.Runtime.ExceptionServices type internal ITrampolineInvocation = - abstract MoveNext: unit -> unit + abstract MoveNext: unit -> bool abstract IsCompleted: bool - abstract ReplayExceptionIfStored: unit -> unit -[] -type internal CancellableStateMachineData<'T> = - val mutable Result: 'T - val mutable NextInvocation: ITrampolineInvocation voption - -and internal CancellableStateMachine<'TOverall> = ResumableStateMachine> -and internal ICancellableStateMachine<'TOverall> = IResumableStateMachine> -and internal CancellableResumptionFunc<'TOverall> = ResumptionFunc> -and internal CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> -and internal CancellableCode<'TOverall, 'T> = ResumableCode, 'T> +type internal CancellableStateMachine<'TOverall> = ResumableStateMachine<'TOverall> +type internal ICancellableStateMachine<'TOverall> = IResumableStateMachine<'TOverall> +type internal CancellableResumptionFunc<'TOverall> = ResumptionFunc<'TOverall> +type internal CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo<'TOverall> +type internal CancellableCode<'TOverall, 'T> = ResumableCode<'TOverall, 'T> type internal ITrampolineInvocation<'T> = inherit ITrampolineInvocation abstract Result: 'T -type internal ICancellableInvokable<'T> = - abstract Create: bool -> ITrampolineInvocation<'T> - [] type internal Trampoline = - member RunDelayed: ITrampolineInvocation * ITrampolineInvocation -> unit + member SetDelayed: ITrampolineInvocation -> unit member RunImmediate: ITrampolineInvocation -> unit + member ReplayException: unit -> unit static member Current: Trampoline member IsCancelled: bool member ThrowIfCancellationRequested: unit -> unit @@ -53,21 +44,14 @@ type internal Trampoline = [] type internal CancellableInvocation<'T, 'Machine - when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> = - interface ICancellableInvokable<'T> + when 'Machine: struct and 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>> = interface ITrampolineInvocation<'T> new: machine: 'Machine -> CancellableInvocation<'T, 'Machine> [] type internal Cancellable<'T> = - new: invokable: ICancellableInvokable<'T> -> Cancellable<'T> - member GetInvocation: bool -> ITrampolineInvocation<'T> - -[] -module internal ExceptionDispatchInfoHelpers = - type ExceptionDispatchInfo with - member ThrowAny: unit -> 'T - static member RestoreOrCapture: exn -> ExceptionDispatchInfo + new: clone: (unit -> ITrampolineInvocation<'T>) -> Cancellable<'T> + member GetInvocation: unit -> ITrampolineInvocation<'T> type internal CancellableBuilder = new: unit -> CancellableBuilder @@ -115,7 +99,6 @@ module internal CancellableAutoOpens = val cancellable: CancellableImplementation.CancellableBuilder module internal Cancellable = - val run: ct: CancellationToken -> code: Cancellable<'a> -> ITrampolineInvocation<'a> val runWithoutCancellation: code: Cancellable<'a> -> 'a val toAsync: code: Cancellable<'a> -> Async<'a> val token: unit -> Cancellable From f3e67665b0046296d3191282a34899bcd17cf3d5 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 21 Jul 2025 17:16:28 +0200 Subject: [PATCH 14/14] fix oce filtering in try .. with --- src/Compiler/Utilities/Cancellable.fs | 55 ++++++++----------- src/Compiler/Utilities/Cancellable.fsi | 2 - .../ModuleReaderCancellationTests.fs | 5 -- 3 files changed, 22 insertions(+), 40 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index c8337a4fdff..fc5160dd766 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -16,18 +16,11 @@ open System.Threading [] type Cancellable = - static let tokenHolder = AsyncLocal() + static let tokenHolder = AsyncLocal() - static let guard = - String.IsNullOrWhiteSpace(Environment.GetEnvironmentVariable("DISABLE_CHECKANDTHROW_ASSERT")) + static member HasCancellationToken = tokenHolder.Value <> CancellationToken.None - 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 Token = tokenHolder.Value static member UseToken() = async { @@ -37,23 +30,22 @@ type Cancellable = static member UsingToken(ct) = let oldCt = tokenHolder.Value - tokenHolder.Value <- ValueSome ct + tokenHolder.Value <- ct { new IDisposable with member _.Dispose() = tokenHolder.Value <- oldCt } static member CheckAndThrow() = - let token = ensureToken "CheckAndThrow invoked outside of Cancellable computation." - token.ThrowIfCancellationRequested() + tokenHolder.Value.ThrowIfCancellationRequested() static member TryCheckAndThrow() = - match tokenHolder.Value with - | ValueNone -> () - | ValueSome token -> token.ThrowIfCancellationRequested() + tokenHolder.Value.ThrowIfCancellationRequested() namespace Internal.Utilities.Library.CancellableImplementation +type Cancellable = FSharp.Compiler.Cancellable + open System open System.Threading @@ -62,7 +54,6 @@ open FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.CompilerServices open System.Runtime.CompilerServices open System.Runtime.ExceptionServices -open System.Diagnostics type ITrampolineInvocation = abstract member MoveNext: unit -> bool @@ -80,7 +71,7 @@ type PendingInvocation = | Immediate of ITrampolineInvocation [] -type Trampoline(cancellationToken: CancellationToken) = +type Trampoline() = let mutable bindDepth = 0 @@ -101,11 +92,6 @@ type Trampoline(cancellationToken: CancellationToken) = edi.Throw() | _ -> () - member this.IsCancelled = cancellationToken.IsCancellationRequested - - member this.ThrowIfCancellationRequested() = - cancellationToken.ThrowIfCancellationRequested() - member this.ShoudBounce = bindDepth % bindDepthLimit = 0 member this.SetDelayed(invocation) = pending.Push(Delayed invocation) @@ -142,8 +128,8 @@ type Trampoline(cancellationToken: CancellationToken) = static member Current = current.Value.Value - static member Install ct = - current.Value <- ValueSome <| Trampoline ct + static member Install() = + current.Value <- ValueSome <| Trampoline() type ITrampolineInvocation<'T> = inherit ITrampolineInvocation @@ -174,12 +160,15 @@ type Cancellable<'T>(clone: unit -> ITrampolineInvocation<'T>) = [] module CancellableCode = - let inline filterCancellation (catch: exn -> CancellableCode<_, _>) exn = - CancellableCode(fun sm -> Trampoline.Current.IsCancelled || (catch exn).Invoke(&sm)) + let inline filterCancellation (catch: exn -> CancellableCode<_, _>) (exn: exn) = + CancellableCode(fun sm -> + match exn with + | :? OperationCanceledException as oce when oce.CancellationToken = Cancellable.Token -> raise exn + | _ -> (catch exn).Invoke(&sm)) let inline throwIfCancellationRequested (code: CancellableCode<_, _>) = CancellableCode(fun sm -> - Trampoline.Current.ThrowIfCancellationRequested() + Cancellable.Token.ThrowIfCancellationRequested() code.Invoke(&sm)) type CancellableBuilder() = @@ -194,6 +183,7 @@ type CancellableBuilder() = CancellableCode<'T, _>(fun sm -> sm.Data <- value true) + |> throwIfCancellationRequested member inline _.Combine (code1: CancellableCode<'TOverall, unit>, code2: CancellableCode<'TOverall, 'T>) @@ -307,7 +297,6 @@ type CancellableBuilder() = namespace Internal.Utilities.Library -open System open System.Threading type Cancellable<'T> = CancellableImplementation.Cancellable<'T> @@ -322,19 +311,19 @@ module Cancellable = let run (code: Cancellable<_>) = let invocation = code.GetInvocation() - Trampoline.Install FSharp.Compiler.Cancellable.Token + Trampoline.Install() Trampoline.Current.RunImmediate invocation invocation.Result let runWithoutCancellation code = - use _ = FSharp.Compiler.Cancellable.UsingToken CancellationToken.None + use _ = Cancellable.UsingToken CancellationToken.None run code let toAsync code = async { - use! _holder = FSharp.Compiler.Cancellable.UseToken() + use! _holder = Cancellable.UseToken() return run code } let token () = - cancellable { FSharp.Compiler.Cancellable.Token } + cancellable { Cancellable.Token } diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 07e44740462..5b41046d6e3 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -38,8 +38,6 @@ type internal Trampoline = member RunImmediate: ITrampolineInvocation -> unit member ReplayException: unit -> unit static member Current: Trampoline - member IsCancelled: bool - member ThrowIfCancellationRequested: unit -> unit member ShoudBounce: bool [] diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index f307586cd5c..dffede3efba 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