From 403e3aaf65e36366abed337104421fe2c67ce2ff Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 15:30:39 +0100 Subject: [PATCH 1/9] wip --- src/Compiler/Checking/CheckDeclarations.fs | 47 ++++------ src/Compiler/Driver/CompilerImports.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 5 -- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 - src/Compiler/Utilities/Cancellable.fs | 88 ++++++++++--------- src/Compiler/Utilities/Cancellable.fsi | 6 +- 6 files changed, 66 insertions(+), 84 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index af3e712a8db..70b3cd38098 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5349,7 +5349,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 @@ -5440,7 +5439,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 = @@ -5476,14 +5474,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 = @@ -5492,14 +5487,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 { @@ -5524,21 +5514,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) } @@ -5775,7 +5759,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/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 8478429a452..ca223e6df39 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2255,7 +2255,7 @@ and [] TcImports r: AssemblyResolution ) : Async<(_ * (unit -> AvailableImportedAssembly list)) option> = async { - do! Cancellable.UseToken() + use! _holder = Cancellable.UseToken() CheckDisposed() let m = r.originalReference.Range let fileName = r.resolvedPath diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 69d1f4fc306..bd964a85417 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -891,7 +891,6 @@ type StackGuard(maxDepth: int, name: string) = try if depth % maxDepth = 0 then - async { do! Async.SwitchToNewThread() Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})" @@ -903,10 +902,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 e5a4c8e7f8a..6cf3a5f2184 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -462,8 +462,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/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index ad739b5039e..43be3dac3a0 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -21,7 +21,7 @@ type Cancellable = static member UseToken() = async { let! ct = Async.CancellationToken - tokenHolder.Value <- ValueSome ct + return Cancellable.UsingToken ct } static member UsingToken(ct) = @@ -47,9 +47,7 @@ open System open System.Threading open FSharp.Compiler -#if !FSHARPCORE_USE_PACKAGE open FSharp.Core.CompilerServices.StateMachineHelpers -#endif [] type ValueOrCancelled<'TResult> = @@ -57,34 +55,45 @@ type ValueOrCancelled<'TResult> = | Cancelled of ``exception``: OperationCanceledException [] -type Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) +type Cancellable<'T> = Cancellable of (CancellationToken * int -> ValueOrCancelled<'T>) module Cancellable = - let inline run (ct: CancellationToken) (Cancellable oper) = + let maxDepth = 100 + + let inline run (ct: CancellationToken, depth: int) (Cancellable oper) = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) else try - use _ = Cancellable.UsingToken(ct) - oper ct + if depth % maxDepth = 0 then + Async.RunImmediate( + async { + do! Async.SwitchToThreadPool() + return oper (ct, depth + 1) + }, + cancellationToken = ct + ) + else + oper (ct, depth + 1) with | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise let fold f acc seq = - Cancellable(fun ct -> + Cancellable(fun (ct, depth) -> let mutable acc = ValueOrCancelled.Value acc for x in seq do match acc with - | ValueOrCancelled.Value accv -> acc <- run ct (f accv x) + | ValueOrCancelled.Value accv -> acc <- run (ct, depth) (f accv x) | ValueOrCancelled.Cancelled _ -> () acc) let runWithoutCancellation comp = - let res = run CancellationToken.None comp + use _ = Cancellable.UsingToken CancellationToken.None + let res = run (CancellationToken.None, 1) comp match res with | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" @@ -93,7 +102,8 @@ module Cancellable = let toAsync c = async { let! ct = Async.CancellationToken - let res = run ct c + use! _holder = Cancellable.UseToken() + let res = run (ct, 1) c return! Async.FromContinuations(fun (cont, _econt, ccont) -> @@ -102,54 +112,51 @@ module Cancellable = | ValueOrCancelled.Cancelled ce -> ccont ce) } - let token () = Cancellable(ValueOrCancelled.Value) + let token () = + Cancellable(fun (ct, _) -> ValueOrCancelled.Value ct) type CancellableBuilder() = member inline _.Delay([] f) = - Cancellable(fun ct -> + Cancellable(fun state -> let (Cancellable g) = f () - g ct) + g state) member inline _.Bind(comp, [] k) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> Cancellable.run ct (k v1) + match Cancellable.run state comp with + | ValueOrCancelled.Value v1 -> Cancellable.run state (k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) member inline _.BindReturn(comp, [] k) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif - match Cancellable.run ct comp with + match Cancellable.run state comp with | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) member inline _.Combine(comp1, comp2) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif - match Cancellable.run ct comp1 with - | ValueOrCancelled.Value() -> Cancellable.run ct comp2 + match Cancellable.run state comp1 with + | ValueOrCancelled.Value() -> Cancellable.run state comp2 | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) member inline _.TryWith(comp, [] handler) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif let compRes = try - match Cancellable.run ct comp with + match Cancellable.run state comp with | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn with err -> @@ -159,19 +166,19 @@ type CancellableBuilder() = | ValueOrCancelled.Value res -> match res with | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> Cancellable.run ct (handler err) + | Choice2Of2 err -> Cancellable.run state (handler err) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) member inline _.Using(resource, [] comp) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif + let body = comp resource let compRes = try - match Cancellable.run ct body with + match Cancellable.run state body with | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn with err -> @@ -187,14 +194,13 @@ type CancellableBuilder() = | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) member inline _.TryFinally(comp, [] compensation) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE + Cancellable(fun state -> + __debugPoint "" -#endif let compRes = try - match Cancellable.run ct comp with + match Cancellable.run state comp with | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn with err -> diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index aba96859491..8fc2346de1c 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -5,7 +5,7 @@ open System.Threading [] type Cancellable = - static member internal UseToken: unit -> Async + static member internal UseToken: unit -> Async /// For use in testing only. Cancellable.token should be set only by the cancellable computation. static member internal UsingToken: CancellationToken -> IDisposable @@ -31,12 +31,12 @@ type internal ValueOrCancelled<'TResult> = /// 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>) +type internal Cancellable<'T> = Cancellable of (CancellationToken * int -> ValueOrCancelled<'T>) module internal Cancellable = /// Run a cancellable computation using the given cancellation token - val inline run: ct: CancellationToken -> Cancellable<'T> -> ValueOrCancelled<'T> + val inline run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> From 699cce3d2f39ffc550a8415bedddab7e297b8968 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 17:56:28 +0100 Subject: [PATCH 2/9] wip --- src/Compiler/Utilities/Cancellable.fs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 43be3dac3a0..446416e1909 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -67,9 +67,9 @@ module Cancellable = else try if depth % maxDepth = 0 then - Async.RunImmediate( + Async.RunSynchronously( async { - do! Async.SwitchToThreadPool() + do! Async.SwitchToNewThread() return oper (ct, depth + 1) }, cancellationToken = ct @@ -81,12 +81,12 @@ module Cancellable = | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise let fold f acc seq = - Cancellable(fun (ct, depth) -> + Cancellable(fun state -> let mutable acc = ValueOrCancelled.Value acc for x in seq do match acc with - | ValueOrCancelled.Value accv -> acc <- run (ct, depth) (f accv x) + | ValueOrCancelled.Value accv -> acc <- run state (f accv x) | ValueOrCancelled.Cancelled _ -> () acc) @@ -218,7 +218,8 @@ type CancellableBuilder() = member inline _.Return v = Cancellable(fun _ -> ValueOrCancelled.Value v) - member inline _.ReturnFrom(v: Cancellable<'T>) = v + member inline _.ReturnFrom(v: Cancellable<'T>) = + Cancellable(fun state -> Cancellable.run state v) member inline _.Zero() = Cancellable(fun _ -> ValueOrCancelled.Value()) From ff40d812fb98ac9de0f4fe7188d9e2ee2c8be832 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 19:08:22 +0100 Subject: [PATCH 3/9] fix --- src/Compiler/Utilities/Cancellable.fsi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 8fc2346de1c..1c8a61bf807 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -35,6 +35,8 @@ type internal Cancellable<'T> = Cancellable of (CancellationToken * int -> Value module internal Cancellable = + val maxDepth: int + /// Run a cancellable computation using the given cancellation token val inline run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> From 8a9a6be7b511683803aff462449e8dbf3cb54a78 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 20:07:18 +0100 Subject: [PATCH 4/9] separate runWithStackGuard func --- src/Compiler/Utilities/Cancellable.fs | 25 ++++++++++++++----------- src/Compiler/Utilities/Cancellable.fsi | 2 ++ 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 446416e1909..5c359224e43 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -66,20 +66,23 @@ module Cancellable = ValueOrCancelled.Cancelled(OperationCanceledException ct) else try - if depth % maxDepth = 0 then - Async.RunSynchronously( - async { - do! Async.SwitchToNewThread() - return oper (ct, depth + 1) - }, - cancellationToken = ct - ) - else - oper (ct, depth + 1) + oper (ct, depth) with | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise + let runWithStackGuard (ct, depth) oper = + if depth % maxDepth = 0 then + Async.RunSynchronously( + async { + do! Async.SwitchToNewThread() + return run (ct, depth + 1) oper + }, + cancellationToken = ct + ) + else + run (ct, depth + 1) oper + let fold f acc seq = Cancellable(fun state -> let mutable acc = ValueOrCancelled.Value acc @@ -219,7 +222,7 @@ type CancellableBuilder() = Cancellable(fun _ -> ValueOrCancelled.Value v) member inline _.ReturnFrom(v: Cancellable<'T>) = - Cancellable(fun state -> Cancellable.run state v) + Cancellable(fun state -> Cancellable.runWithStackGuard state v) member inline _.Zero() = Cancellable(fun _ -> ValueOrCancelled.Value()) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 1c8a61bf807..3b9a6dd6926 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -40,6 +40,8 @@ module internal Cancellable = /// Run a cancellable computation using the given cancellation token val inline run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> + val runWithStackGuard: CancellationToken * int -> (Cancellable<'T> -> ValueOrCancelled<'T>) + val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> /// Run the computation in a mode where it may not be cancelled. The computation never results in a From a7a8026d8023bd8059bdf953f5d8f3fbcb2f94fa Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 20:29:50 +0100 Subject: [PATCH 5/9] wip --- src/Compiler/Utilities/Cancellable.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 5c359224e43..11d7b10331a 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -130,7 +130,7 @@ type CancellableBuilder() = __debugPoint "" - match Cancellable.run state comp with + match Cancellable.runWithStackGuard state comp with | ValueOrCancelled.Value v1 -> Cancellable.run state (k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) @@ -139,7 +139,7 @@ type CancellableBuilder() = __debugPoint "" - match Cancellable.run state comp with + match Cancellable.runWithStackGuard state comp with | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) From 20ef1317c1a0c07230772e3a9967759329bf5dd4 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Jan 2025 20:32:54 +0100 Subject: [PATCH 6/9] wip --- src/Compiler/Utilities/Cancellable.fs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 11d7b10331a..6a78f38833d 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -73,13 +73,11 @@ module Cancellable = let runWithStackGuard (ct, depth) oper = if depth % maxDepth = 0 then - Async.RunSynchronously( - async { - do! Async.SwitchToNewThread() - return run (ct, depth + 1) oper - }, - cancellationToken = ct - ) + async { + do! Async.SwitchToNewThread() + return run (ct, depth + 1) oper + } + |> Async.RunSynchronously else run (ct, depth + 1) oper From ed3e1afa54cd18d14eae1332fd15a352b936b84e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 30 Jan 2025 10:02:44 +0100 Subject: [PATCH 7/9] do not inline run --- src/Compiler/Utilities/Cancellable.fs | 27 ++++++++++++-------------- src/Compiler/Utilities/Cancellable.fsi | 4 +--- 2 files changed, 13 insertions(+), 18 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 6a78f38833d..24782709655 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -61,26 +61,23 @@ module Cancellable = let maxDepth = 100 - let inline run (ct: CancellationToken, depth: int) (Cancellable oper) = + let run (ct: CancellationToken, depth: int) (Cancellable oper) = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) else try - oper (ct, depth) + if depth % maxDepth = 0 then + async { + do! Async.SwitchToNewThread() + return oper (ct, depth + 1) + } + |> Async.RunSynchronously + else + oper (ct, depth + 1) with | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise - let runWithStackGuard (ct, depth) oper = - if depth % maxDepth = 0 then - async { - do! Async.SwitchToNewThread() - return run (ct, depth + 1) oper - } - |> Async.RunSynchronously - else - run (ct, depth + 1) oper - let fold f acc seq = Cancellable(fun state -> let mutable acc = ValueOrCancelled.Value acc @@ -128,7 +125,7 @@ type CancellableBuilder() = __debugPoint "" - match Cancellable.runWithStackGuard state comp with + match Cancellable.run state comp with | ValueOrCancelled.Value v1 -> Cancellable.run state (k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) @@ -137,7 +134,7 @@ type CancellableBuilder() = __debugPoint "" - match Cancellable.runWithStackGuard state comp with + match Cancellable.run state comp with | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) @@ -220,7 +217,7 @@ type CancellableBuilder() = Cancellable(fun _ -> ValueOrCancelled.Value v) member inline _.ReturnFrom(v: Cancellable<'T>) = - Cancellable(fun state -> Cancellable.runWithStackGuard state v) + Cancellable(fun state -> Cancellable.run state v) member inline _.Zero() = Cancellable(fun _ -> ValueOrCancelled.Value()) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 3b9a6dd6926..46dedede2f5 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -38,9 +38,7 @@ module internal Cancellable = val maxDepth: int /// Run a cancellable computation using the given cancellation token - val inline run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> - - val runWithStackGuard: CancellationToken * int -> (Cancellable<'T> -> ValueOrCancelled<'T>) + val run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> From 7fe442547f34927f6aafaeb5f8f26d91fc4b0261 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 30 Jan 2025 12:07:02 +0100 Subject: [PATCH 8/9] wip --- src/Compiler/Driver/CompilerImports.fs | 1 + src/Compiler/Utilities/Cancellable.fs | 27 ++++++++++--------- src/Compiler/Utilities/Cancellable.fsi | 6 +---- .../ModuleReaderCancellationTests.fs | 2 -- 4 files changed, 17 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index ca223e6df39..cef3af610fd 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2327,6 +2327,7 @@ and [] TcImports async { CheckDisposed() + use! _holder = Cancellable.UseToken() let tcConfig = tcConfigP.Get ctok diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 24782709655..829e130a2c5 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -61,22 +61,25 @@ module Cancellable = let maxDepth = 100 + let handleCheckAndThrow (ct: CancellationToken, depth) oper = + try + oper (ct, depth) + with + | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e + | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise + let run (ct: CancellationToken, depth: int) (Cancellable oper) = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) else - try - if depth % maxDepth = 0 then - async { - do! Async.SwitchToNewThread() - return oper (ct, depth + 1) - } - |> Async.RunSynchronously - else - oper (ct, depth + 1) - with - | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e - | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise + if depth % maxDepth = 0 then + async { + do! Async.SwitchToNewThread() + return handleCheckAndThrow (ct, depth + 1) oper + } + |> Async.RunSynchronously + else + handleCheckAndThrow (ct, depth + 1) oper let fold f acc seq = Cancellable(fun state -> diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 46dedede2f5..053b0f221ff 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -5,11 +5,9 @@ open System.Threading [] type Cancellable = + /// Capture the current cancellation token for use in CheckAndThrow. static member internal UseToken: unit -> Async - /// For use in testing only. Cancellable.token should be set only by the cancellable computation. - static member internal UsingToken: CancellationToken -> IDisposable - static member HasCancellationToken: bool static member Token: CancellationToken @@ -35,8 +33,6 @@ type internal Cancellable<'T> = Cancellable of (CancellationToken * int -> Value module internal Cancellable = - val maxDepth: int - /// Run a cancellable computation using the given cancellation token val run: CancellationToken * int -> Cancellable<'T> -> ValueOrCancelled<'T> diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index 62e36de58b9..0536e20c99c 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -22,7 +22,6 @@ let mutable private wasCancelled = false let runCancelFirstTime f = let mutable requestCount = 0 fun () -> - use _ = Cancellable.UsingToken cts.Token if requestCount = 0 then cts.Cancel() @@ -150,7 +149,6 @@ let referenceReaderProject getPreTypeDefs (cancelOnModuleAccess: bool) (options: let parseAndCheck path source options = cts <- new CancellationTokenSource() wasCancelled <- false - use _ = Cancellable.UsingToken cts.Token try match Async.RunSynchronously(checker.ParseAndCheckFileInProject(path, 0, SourceText.ofString source, options), cancellationToken = cts.Token) with From 3f60933eab5e7ad39e35f03291421fab78197141 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 30 Jan 2025 12:24:23 +0100 Subject: [PATCH 9/9] f --- src/Compiler/Utilities/Cancellable.fs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 829e130a2c5..b29a42bd670 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -71,15 +71,14 @@ module Cancellable = let run (ct: CancellationToken, depth: int) (Cancellable oper) = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) + else if depth % maxDepth = 0 then + async { + do! Async.SwitchToNewThread() + return handleCheckAndThrow (ct, depth + 1) oper + } + |> Async.RunSynchronously else - if depth % maxDepth = 0 then - async { - do! Async.SwitchToNewThread() - return handleCheckAndThrow (ct, depth + 1) oper - } - |> Async.RunSynchronously - else - handleCheckAndThrow (ct, depth + 1) oper + handleCheckAndThrow (ct, depth + 1) oper let fold f acc seq = Cancellable(fun state ->