From 2bfbc99c261e23ae8ed8d96906e358914da332a8 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 27 Nov 2023 18:06:53 +0100 Subject: [PATCH 1/7] Cancellable: set token from node/async in features code --- src/Compiler/Facilities/BuildGraph.fs | 15 ++++++++- src/Compiler/Service/service.fs | 39 ++++++++++++++++++++++++ src/Compiler/Utilities/Cancellable.fs | 42 ++++++++++---------------- src/Compiler/Utilities/Cancellable.fsi | 1 + 4 files changed, 70 insertions(+), 27 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 1df58c1024..3df9e2bcba 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -17,12 +17,14 @@ let wrapThreadStaticInfo computation = async { let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase + let ct = Cancellable.Token try return! computation finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase + Cancellable.Token <- ct } type Async<'T> with @@ -125,6 +127,8 @@ type NodeCode private () = static member RunImmediate(computation: NodeCode<'T>, ct: CancellationToken) = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase + let ct2 = Cancellable.Token + assert (ct = ct2) try try @@ -132,13 +136,15 @@ type NodeCode private () = async { DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase + Cancellable.Token <- ct2 return! computation |> Async.AwaitNodeCode } - Async.StartImmediateAsTask(work, cancellationToken = ct).Result + Async.StartImmediateAsTask(work, cancellationToken = ct2).Result finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase + Cancellable.Token <- ct2 with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise (ex.InnerExceptions[0]) @@ -148,12 +154,18 @@ type NodeCode private () = static member StartAsTask_ForTesting(computation: NodeCode<'T>, ?ct: CancellationToken) = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase + let ct2 = Cancellable.Token + + match ct with + | Some ct -> assert (ct = ct2) + | _ -> () try let work = async { DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase + Cancellable.Token <- ct2 return! computation |> Async.AwaitNodeCode } @@ -161,6 +173,7 @@ type NodeCode private () = finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase + Cancellable.Token <- ct2 static member CancellationToken = cancellationToken diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 2a11e46df4..19b5ba52b6 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -500,6 +500,9 @@ type BackgroundCompiler Activity.Tags.cache, cache.ToString() |] + let! ct = Async.CancellationToken + use _ = Cancellable.UsingToken(ct) + if cache then let hash = sourceText.GetHashCode() |> int64 @@ -541,6 +544,9 @@ type BackgroundCompiler "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -690,6 +696,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! cachedResults = node { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) @@ -732,6 +741,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -760,6 +772,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -815,6 +830,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -834,6 +852,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -974,6 +995,9 @@ type BackgroundCompiler Activity.Tags.userOpName, userOpName |] + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1016,6 +1040,9 @@ type BackgroundCompiler /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = node { + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1149,6 +1176,9 @@ type BackgroundCompiler // Do we assume .NET Framework references for scripts? let assumeDotNetFramework = defaultArg assumeDotNetFramework true + let! ct = Cancellable.token () + use _ = Cancellable.UsingToken(ct) + let extraFlags = if previewEnabled then [| "--langversion:preview" |] @@ -1269,6 +1299,9 @@ type BackgroundCompiler |] async { + let! ct = Async.CancellationToken + use _ = Cancellable.UsingToken(ct) + let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous @@ -1514,6 +1547,9 @@ type FSharpChecker use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { + let! ct = Async.CancellationToken + use _ = Cancellable.UsingToken(ct) + let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) } @@ -1633,6 +1669,9 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" node { + let! ct = NodeCode.CancellationToken + use _ = Cancellable.UsingToken(ct) + if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) else diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 59e7def4c1..52d32b25c0 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -2,47 +2,38 @@ namespace FSharp.Compiler open System open System.Threading -open Internal.Utilities.Library [] type Cancellable = [] - static val mutable private tokens: CancellationToken list + static val mutable private token: CancellationToken option + + static member UsingToken(ct) = + let oldCt = Cancellable.token + + Cancellable.token <- Some ct - static let disposable = { new IDisposable with member this.Dispose() = - Cancellable.Tokens <- Cancellable.Tokens |> List.tail + Cancellable.token <- oldCt } - static member Tokens - with private get () = - match box Cancellable.tokens with - | Null -> [] - | _ -> Cancellable.tokens - and private set v = Cancellable.tokens <- v - - static member UsingToken(ct) = - Cancellable.Tokens <- ct :: Cancellable.Tokens - disposable - - static member Token = - match Cancellable.Tokens with - | [] -> CancellationToken.None - | token :: _ -> token + static member Token + with get () = + match Cancellable.token with + | None -> CancellationToken.None + | Some ct -> ct + and internal set v = Cancellable.token <- Some v - /// There may be multiple tokens if `UsingToken` is called multiple times, producing scoped structure. - /// We're interested in the current, i.e. the most recent, one. static member CheckAndThrow() = - match Cancellable.Tokens with - | [] -> () - | token :: _ -> token.ThrowIfCancellationRequested() + match Cancellable.token with + | Some token -> token.ThrowIfCancellationRequested() + | _ -> () namespace Internal.Utilities.Library open System open System.Threading -open FSharp.Compiler #if !FSHARPCORE_USE_PACKAGE open FSharp.Core.CompilerServices.StateMachineHelpers @@ -63,7 +54,6 @@ module Cancellable = ValueOrCancelled.Cancelled(OperationCanceledException ct) else try - use _ = Cancellable.UsingToken(ct) oper ct with :? OperationCanceledException as e -> ValueOrCancelled.Cancelled(OperationCanceledException e.CancellationToken) diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 23515432bd..b6bc2168a3 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -7,6 +7,7 @@ open System.Threading type Cancellable = static member internal UsingToken: CancellationToken -> IDisposable static member Token: CancellationToken + static member internal Token: CancellationToken with set static member CheckAndThrow: unit -> unit namespace Internal.Utilities.Library From 9ff8ccd73b2dc126d48aab197bdf71f11aeba648 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 27 Nov 2023 18:24:23 +0100 Subject: [PATCH 2/7] Fantomas --- src/Compiler/Service/service.fs | 2 +- src/Compiler/Utilities/Cancellable.fs | 3 +-- src/Compiler/Utilities/Cancellable.fsi | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 19b5ba52b6..c5b6e64ffd 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -1301,7 +1301,7 @@ type BackgroundCompiler async { let! ct = Async.CancellationToken use _ = Cancellable.UsingToken(ct) - + let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 52d32b25c0..5846698ace 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -14,8 +14,7 @@ type Cancellable = Cancellable.token <- Some ct { new IDisposable with - member this.Dispose() = - Cancellable.token <- oldCt + member this.Dispose() = Cancellable.token <- oldCt } static member Token diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index b6bc2168a3..6e36d7ecb6 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -7,7 +7,7 @@ open System.Threading type Cancellable = static member internal UsingToken: CancellationToken -> IDisposable static member Token: CancellationToken - static member internal Token: CancellationToken with set + static member internal Token: CancellationToken with set static member CheckAndThrow: unit -> unit namespace Internal.Utilities.Library From 3e1729859873bc5e7d98601258841381d1ef855d Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 27 Nov 2023 22:19:09 +0100 Subject: [PATCH 3/7] Fix wrong token --- src/Compiler/Facilities/BuildGraph.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 3df9e2bcba..543592820a 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -140,7 +140,7 @@ type NodeCode private () = return! computation |> Async.AwaitNodeCode } - Async.StartImmediateAsTask(work, cancellationToken = ct2).Result + Async.StartImmediateAsTask(work, cancellationToken = ct).Result finally DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger DiagnosticsThreadStatics.BuildPhase <- phase From d675acb82b745581259d801dc4e60166685aa0ac Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 27 Nov 2023 22:19:18 +0100 Subject: [PATCH 4/7] Remove assert --- src/Compiler/Facilities/BuildGraph.fs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 543592820a..8927862c23 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -128,7 +128,6 @@ type NodeCode private () = let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger let phase = DiagnosticsThreadStatics.BuildPhase let ct2 = Cancellable.Token - assert (ct = ct2) try try @@ -156,10 +155,6 @@ type NodeCode private () = let phase = DiagnosticsThreadStatics.BuildPhase let ct2 = Cancellable.Token - match ct with - | Some ct -> assert (ct = ct2) - | _ -> () - try let work = async { From 15d1e68f3e9c6700eb922f1ea74bc34460618486 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 28 Nov 2023 13:34:16 +0100 Subject: [PATCH 5/7] Set token in fsi --- src/Compiler/Service/FSharpCheckerResults.fs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index b4925538a1..2b23d85a7c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3560,6 +3560,9 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = cancellable { + let! ct = Cancellable.token () + use _ = Cancellable.UsingToken(ct) + let userOpName = defaultArg userOpName "Unknown" let fileName = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability From 458e798e2226189697084d64757c9ec44799ee6e Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 28 Nov 2023 13:47:37 +0100 Subject: [PATCH 6/7] Use cancellation token default value instead of option --- src/Compiler/Utilities/Cancellable.fs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 5846698ace..c702e3b7a0 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -6,28 +6,23 @@ open System.Threading [] type Cancellable = [] - static val mutable private token: CancellationToken option + static val mutable private token: CancellationToken static member UsingToken(ct) = let oldCt = Cancellable.token - Cancellable.token <- Some ct + Cancellable.token <- ct { new IDisposable with member this.Dispose() = Cancellable.token <- oldCt } static member Token - with get () = - match Cancellable.token with - | None -> CancellationToken.None - | Some ct -> ct - and internal set v = Cancellable.token <- Some v + with get () = Cancellable.token + and internal set v = Cancellable.token <- v static member CheckAndThrow() = - match Cancellable.token with - | Some token -> token.ThrowIfCancellationRequested() - | _ -> () + Cancellable.token.ThrowIfCancellationRequested() namespace Internal.Utilities.Library From c5551029c96712696ffba138f4456cb15ac3c3c1 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 29 Nov 2023 12:19:59 +0100 Subject: [PATCH 7/7] More cancellation token in fsi --- src/Compiler/Interactive/fsi.fs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 4ed7363f6c..4cec0c7a8d 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4089,6 +4089,7 @@ type FsiInteractionProcessor ?cancellationToken: CancellationToken ) = let cancellationToken = defaultArg cancellationToken CancellationToken.None + use _ = Cancellable.UsingToken(cancellationToken) if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -4217,6 +4218,7 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None + use _ = Cancellable.UsingToken(cancellationToken) use _ = UseBuildPhase BuildPhase.Interactive use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID @@ -4893,6 +4895,7 @@ type FsiEvaluationSession SpawnInteractiveServer(fsi, fsiOptions, fsiConsoleOutput) use _ = UseBuildPhase BuildPhase.Interactive + use _ = Cancellable.UsingToken(CancellationToken.None) if fsiOptions.Interact then // page in the type check env