From 12275426366f3ede49eb7fa930115f537f53772e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 16 Jan 2025 16:48:01 +0100 Subject: [PATCH] remove cancellable ce --- src/Compiler/Checking/CheckDeclarations.fs | 78 ++++--- src/Compiler/Checking/CheckDeclarations.fsi | 4 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 20 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 - src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 - src/Compiler/Interactive/fsi.fs | 2 +- src/Compiler/Service/BackgroundCompiler.fs | 10 +- src/Compiler/Service/FSharpCheckerResults.fs | 16 +- src/Compiler/Service/FSharpCheckerResults.fsi | 6 +- src/Compiler/Service/IncrementalBuild.fs | 1 - src/Compiler/Service/TransparentCompiler.fs | 7 +- src/Compiler/Service/service.fs | 28 +++ src/Compiler/Utilities/Cancellable.fs | 191 +----------------- src/Compiler/Utilities/Cancellable.fsi | 70 +------ .../ModuleReaderCancellationTests.fs | 4 +- 16 files changed, 106 insertions(+), 343 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 23c547b36b8..c41ab6408f5 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4,7 +4,6 @@ module internal FSharp.Compiler.CheckDeclarations open System open System.Collections.Generic -open System.Threading open FSharp.Compiler.Diagnostics open Internal.Utilities.Collections @@ -4849,8 +4848,8 @@ module TcDeclarations = // Bind module types //------------------------------------------------------------------------- -let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Cancellable = - cancellable { +let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async = + async { let g = cenv.g try match synSigDecl with @@ -5006,7 +5005,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = - cancellable { + async { // Ensure the .Deref call in UpdateAccModuleOrNamespaceType succeeds if cenv.compilingCanonicalFslibModuleType then let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs @@ -5022,10 +5021,17 @@ and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = } and TcSignatureElementsNonMutRec cenv parent typeNames endm env defs = - Cancellable.fold (TcSignatureElementNonMutRec cenv parent typeNames endm) env defs + async { + match defs with + | def :: defs -> + let! env = TcSignatureElementNonMutRec cenv parent typeNames endm env def + return! TcSignatureElementsNonMutRec cenv parent typeNames endm env defs + | [] -> + return env + } and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (defs: SynModuleSigDecl list) = - cancellable { + async { let m = match defs with [] -> m | _ -> defs |> List.map (fun d -> d.Range) |> List.reduce unionRanges let scopem = (defs, m) ||> List.foldBack (fun h m -> unionRanges h.Range m) @@ -5080,7 +5086,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, moduleKind, defs, m: range, xml) = - cancellable { + async { let endm = m.EndRange // use end of range for errors // Create the module type that will hold the results of type checking.... @@ -5237,8 +5243,8 @@ let TcModuleOrNamespaceElementsMutRec (cenv: cenv) parent typeNames m envInitial ([ moduleContents ], [ escapeCheck ], attrs), envAfter, envAfter /// The non-mutually recursive case for a declaration -let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl = - cancellable { +let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl = + async { let g = cenv.g cenv.synArgNameGenerator.Reset() let tpenv = emptyUnscopedTyparEnv @@ -5349,7 +5355,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 +5445,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 = @@ -5473,17 +5477,13 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem with RecoverableException exn -> errorRecovery exn synDecl.Range return ([], [], []), env, env - } + } /// The non-mutually recursive case for a sequence of declarations -and [] TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) (ct: CancellationToken) = - - if ct.IsCancellationRequested then - ValueOrCancelled.Cancelled (OperationCanceledException()) - else +and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) = + async { 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,17 +5492,14 @@ 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) + let! firstDef, env, envAtEnd = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef - 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 + return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ((firstDef :: defsSoFar), env, envAtEnd) otherDefs + } and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 synModuleDecls = - cancellable { + async { // Ensure the deref_nlpath call in UpdateAccModuleOrNamespaceType succeeds if cenv.compilingCanonicalFslibModuleType then let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs @@ -5524,21 +5521,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) } @@ -5750,7 +5741,7 @@ let CheckOneImplFile let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _, _)) = synImplFile let infoReader = InfoReader(g, amap) - cancellable { + async { use _ = Activity.start "CheckDeclarations.CheckOneImplFile" [| @@ -5775,7 +5766,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 @@ -5895,7 +5885,7 @@ let CheckOneImplFile /// Check an entire signature file let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) = - cancellable { + async { use _ = Activity.start "CheckDeclarations.CheckOneSigFile" [| diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index fb4679f2438..058b390a90c 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -61,7 +61,7 @@ val CheckOneImplFile: ModuleOrNamespaceType option * ParsedImplFileInput * FSharpDiagnosticOptions -> - Cancellable + Async val CheckOneSigFile: TcGlobals * @@ -74,7 +74,7 @@ val CheckOneSigFile: FSharpDiagnosticOptions -> TcEnv -> ParsedSigFileInput -> - Cancellable + Async exception NotUpperCaseConstructor of range: range diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 22ea3c7f033..cab9a97e9be 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1312,8 +1312,8 @@ let CheckOneInput tcSink: TcResultsSink, tcState: TcState, input: ParsedInput - ) : Cancellable = - cancellable { + ) : Async = + async { try use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] @@ -1431,7 +1431,8 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger /// Typecheck a single file (or interactive entry into F# Interactive) let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input = - cancellable { + async { + do! Cancellable.UseToken() // Equip loggers to locally filter w.r.t. scope pragmas in each input use _ = UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) @@ -1442,7 +1443,7 @@ let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcG return! CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input) } - |> Cancellable.runWithoutCancellation + |> Async.RunImmediate /// Finish checking multiple files (or one interactive entry into F# Interactive) let CheckMultipleInputsFinish (results, tcState: TcState) = @@ -1458,7 +1459,7 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = (tcEnvAtEndOfLastFile, topAttrs, implFiles, ccuSigsForFiles), tcState let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = - cancellable { + async { let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) let finishedResult = CheckMultipleInputsFinish([ result ], tcState) return finishedResult @@ -1530,8 +1531,8 @@ let CheckOneInputWithCallback input: ParsedInput, _skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool) - : Cancellable> = - cancellable { + : Async> = + async { try CheckSimulateException tcConfig @@ -1905,7 +1906,8 @@ let CheckMultipleInputsUsingGraphMode : Finisher = let (Finisher(finisher = finisher)) = - cancellable { + async { + do! Cancellable.UseToken() use _ = UseDiagnosticsLogger logger let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) let tcSink = TcResultsSink.NoSink @@ -1915,7 +1917,7 @@ let CheckMultipleInputsUsingGraphMode node (checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, currentTcState, input, false) } - |> Cancellable.runWithoutCancellation + |> Async.RunImmediate Finisher( node, diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index fb32a4557cd..a877214c701 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -183,7 +183,7 @@ val CheckOneInput: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> + Async<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> val CheckOneInputWithCallback: node: NodeToTypeCheck -> @@ -196,7 +196,7 @@ val CheckOneInputWithCallback: tcState: TcState * input: ParsedInput * _skipImplIfSigExists: bool -> - Cancellable> + Async> val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -251,4 +251,4 @@ val CheckOneInputAndFinish: tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> - Cancellable<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> + Async<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 69d1f4fc306..84e1cb55360 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -903,10 +903,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/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index c31f210022f..998a654314e 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4809,7 +4809,7 @@ type FsiEvaluationSession member _.ParseAndCheckInteraction(code) = fsiInteractionProcessor.ParseAndCheckInteraction(legacyReferenceResolver, fsiInteractionProcessor.CurrentState, code) - |> Cancellable.runWithoutCancellation + |> Async.RunImmediate member _.InteractiveChecker = checker diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 63d147d005b..6cfb97129f3 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -328,7 +328,7 @@ type internal BackgroundCompiler | FSharpReferencedProject.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async { let! ilReaderOpt = delayedReader.TryGetILModuleReader() match ilReaderOpt with @@ -341,7 +341,6 @@ type internal BackgroundCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -350,13 +349,12 @@ type internal BackgroundCompiler | FSharpReferencedProject.ILModuleReference(nm, getStamp, getReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async { let ilReader = getReader () let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -747,7 +745,6 @@ type internal BackgroundCompiler keepAssemblyContents, suggestNamesForErrors ) - |> Cancellable.toAsync GraphNode.SetPreferredUILang tcConfig.preferredUiLang return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp) @@ -1321,7 +1318,7 @@ type internal BackgroundCompiler "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] - cancellable { + async { // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true let useSdkRefs = defaultArg useSdkRefs true @@ -1411,7 +1408,6 @@ type internal BackgroundCompiler return options, (diags @ diagnostics.Diagnostics) } - |> Cancellable.toAsync member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1c7878c6df8..d2eab102e9b 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -87,8 +87,8 @@ type DelayedILModuleReader = // fast path match box this.result with | null -> - cancellable { - let! ct = Cancellable.token () + async { + let! ct = Async.CancellationToken return lock this.gate (fun () -> @@ -118,7 +118,7 @@ type DelayedILModuleReader = None | _ -> Some this.result) } - | _ -> cancellable.Return(Some this.result) + | _ -> async { return Some this.result } [] type FSharpReferencedProject = @@ -3193,7 +3193,7 @@ module internal ParseAndCheckFile = suggestNamesForErrors: bool ) = - cancellable { + async { use _ = Activity.start "ParseAndCheckFile.CheckOneFile" @@ -3233,7 +3233,7 @@ module internal ParseAndCheckFile = let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) let! resOpt = - cancellable { + async { try let checkForErrors () = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -3666,7 +3666,7 @@ type FSharpCheckFileResults keepAssemblyContents: bool, suggestNamesForErrors: bool ) = - cancellable { + async { let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile( parseResults, @@ -3906,7 +3906,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let keepAssemblyContents = false member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = - cancellable { + async { 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 @@ -3914,7 +3914,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let! ct = Cancellable.token () + let! ct = Async.CancellationToken let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile ( diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 6b0a7f49135..4d0bac57f29 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -46,7 +46,7 @@ type DelayedILModuleReader = /// Will lazily create the ILModuleReader. /// Is only evaluated once and can be called by multiple threads. - member internal TryGetILModuleReader: unit -> Cancellable + member internal TryGetILModuleReader: unit -> Async /// Unused in this API type public FSharpUnresolvedReferencesSet = internal FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list @@ -493,7 +493,7 @@ type public FSharpCheckFileResults = parseErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool -> - Cancellable + Async /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -611,7 +611,7 @@ type internal FsiInteractiveChecker = member internal ParseAndCheckInteraction: sourceText: ISourceText * ?userOpName: string -> - Cancellable + Async module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 872b27fdcd9..a669ce8b7fb 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -277,7 +277,6 @@ type BoundModel private ( None, TcResultsSink.WithSink sink, prevTcInfo.tcState, input ) - |> Cancellable.toAsync fileChecked.Trigger fileName diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index f25b75fe99d..66e8340065b 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -766,7 +766,7 @@ type internal TransparentCompiler | FSharpReferencedProjectSnapshot.PEReference(getStamp, delayedReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async { let! ilReaderOpt = delayedReader.TryGetILModuleReader() match ilReaderOpt with @@ -779,7 +779,6 @@ type internal TransparentCompiler // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false } - |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = delayedReader.OutputFile @@ -788,13 +787,12 @@ type internal TransparentCompiler | FSharpReferencedProjectSnapshot.ILModuleReference(nm, getStamp, getReader) -> { new IProjectReference with member x.EvaluateRawContents() = - cancellable { + async { let ilReader = getReader () let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data } - |> Cancellable.toAsync member x.TryGetLogicalTimeStamp _ = getStamp () |> Some member x.FileName = nm @@ -1433,7 +1431,6 @@ type internal TransparentCompiler prevTcInfo.tcState, input, true) - |> Cancellable.toAsync //fileChecked.Trigger fileName diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 4835b784bf8..4a1599639c1 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -274,6 +274,8 @@ type FSharpChecker let hash = sourceText.GetHashCode() |> int64 async { + do! Cancellable.UseToken() + match braceMatchCache.TryGet(AnyCallerThread, (fileName, hash, options)) with | Some res -> return res | None -> @@ -289,7 +291,9 @@ type FSharpChecker member ic.MatchBraces(fileName, source: string, options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) + ic.MatchBraces(fileName, SourceText.ofString source, parsingOptions, userOpName) + |> Cancellable.UsingToken member ic.GetParsingOptionsFromProjectOptions(options) : FSharpParsingOptions * _ = let sourceFiles = List.ofArray options.SourceFiles @@ -299,26 +303,33 @@ type FSharpChecker member _.ParseFile(fileName, sourceText, options, ?cache, ?userOpName: string) = let cache = defaultArg cache true let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.ParseFile(fileName, sourceText, options, cache, false, userOpName) + |> Cancellable.UsingToken member _.ParseFile(fileName, projectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) + |> Cancellable.UsingToken member ic.ParseFileInProject(fileName, source: string, options, ?cache: bool, ?userOpName: string) = let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) + ic.ParseFile(fileName, SourceText.ofString source, parsingOptions, ?cache = cache, ?userOpName = userOpName) + |> Cancellable.UsingToken member _.GetBackgroundParseResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) + |> Cancellable.UsingToken member _.GetBackgroundCheckResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) + |> Cancellable.UsingToken /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, ?sourceText, ?userOpName: string) = @@ -334,6 +345,8 @@ type FSharpChecker use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { + do! Cancellable.UseToken() + let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) } @@ -379,12 +392,15 @@ type FSharpChecker /// This function is called when a project has been cleaned, and thus type providers should be refreshed. member _.NotifyProjectCleaned(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.NotifyProjectCleaned(options, userOpName) + |> Cancellable.UsingToken member _.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) + |> Cancellable.UsingToken /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -407,6 +423,7 @@ type FSharpChecker options, userOpName ) + |> Cancellable.UsingToken /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -422,6 +439,7 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) + |> Cancellable.UsingToken /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -436,21 +454,25 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + |> Cancellable.UsingToken member _.ParseAndCheckFileInProject(fileName: string, projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckFileInProject(fileName, projectSnapshot, userOpName) + |> Cancellable.UsingToken member _.ParseAndCheckProject(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckProject(options, userOpName) + |> Cancellable.UsingToken member _.ParseAndCheckProject(projectSnapshot: FSharpProjectSnapshot, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ParseAndCheckProject(projectSnapshot, userOpName) + |> Cancellable.UsingToken member _.FindBackgroundReferencesInFile ( @@ -465,6 +487,8 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" async { + do! Cancellable.UseToken() + if fastCheck <> Some true || not captureIdentifiersWhenParsing then return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) else @@ -483,6 +507,8 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" async { + do! Cancellable.UseToken() + let! parseResults = backgroundCompiler.ParseFile(fileName, projectSnapshot, userOpName) if @@ -498,11 +524,13 @@ type FSharpChecker let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) + |> Cancellable.UsingToken member _.GetBackgroundSemanticClassificationForFile(fileName: string, snapshot: FSharpProjectSnapshot, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetSemanticClassificationForFile(fileName, snapshot, userOpName) + |> Cancellable.UsingToken /// For a given script file, get the ProjectOptions implied by the #load closure member _.GetProjectOptionsFromScript diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 9ec81438ca4..c06ce779324 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -18,18 +18,18 @@ type Cancellable = static member Token = ensureToken "Token not available outside of Cancellable computation." + static member internal SetTokenForTesting(ct: CancellationToken) = tokenHolder.Value <- ValueSome ct + static member UseToken() = async { let! ct = Async.CancellationToken tokenHolder.Value <- ValueSome ct } - static member UsingToken(ct) = - let oldCt = tokenHolder.Value - tokenHolder.Value <- ValueSome ct - - { new IDisposable with - member _.Dispose() = tokenHolder.Value <- oldCt + static member UsingToken computation = + async { + do! Cancellable.UseToken() + return! computation } static member CheckAndThrow() = @@ -40,182 +40,3 @@ type Cancellable = match tokenHolder.Value with | ValueNone -> () | ValueSome token -> token.ThrowIfCancellationRequested() - -namespace Internal.Utilities.Library - -open System -open System.Threading -open FSharp.Compiler - -#if !FSHARPCORE_USE_PACKAGE -open FSharp.Core.CompilerServices.StateMachineHelpers -#endif - -[] -type ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException - -[] -type Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) - -module Cancellable = - - let inline run (ct: CancellationToken) (Cancellable oper) = - if ct.IsCancellationRequested then - ValueOrCancelled.Cancelled(OperationCanceledException ct) - else - try - use _ = Cancellable.UsingToken(ct) - oper ct - with :? OperationCanceledException as e -> - ValueOrCancelled.Cancelled(OperationCanceledException e.CancellationToken) - - let fold f acc seq = - Cancellable(fun ct -> - let mutable acc = ValueOrCancelled.Value acc - - for x in seq do - match acc with - | ValueOrCancelled.Value accv -> acc <- run ct (f accv x) - | ValueOrCancelled.Cancelled _ -> () - - acc) - - let runWithoutCancellation comp = - let res = run CancellationToken.None comp - - match res with - | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" - | ValueOrCancelled.Value r -> r - - let toAsync c = - async { - let! ct = Async.CancellationToken - let res = run ct c - - return! - Async.FromContinuations(fun (cont, _econt, ccont) -> - match res with - | ValueOrCancelled.Value v -> cont v - | ValueOrCancelled.Cancelled ce -> ccont ce) - } - - let token () = Cancellable(ValueOrCancelled.Value) - -type CancellableBuilder() = - - member inline _.Delay([] f) = - Cancellable(fun ct -> - let (Cancellable g) = f () - g ct) - - member inline _.Bind(comp, [] k) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> Cancellable.run ct (k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.BindReturn(comp, [] k) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - - match Cancellable.run ct comp with - | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Combine(comp1, comp2) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - - match Cancellable.run ct comp1 with - | ValueOrCancelled.Value() -> Cancellable.run ct comp2 - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.TryWith(comp, [] handler) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - - let compRes = - try - match Cancellable.run ct comp with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> Cancellable.run ct (handler err) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Using(resource, [] comp) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - let body = comp resource - - let compRes = - try - match Cancellable.run ct body with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.TryFinally(comp, [] compensation) = - Cancellable(fun ct -> -#if !FSHARPCORE_USE_PACKAGE - __debugPoint "" -#endif - - let compRes = - try - match Cancellable.run ct comp with - | ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res) - | ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn - with err -> - ValueOrCancelled.Value(Choice2Of2 err) - - match compRes with - | ValueOrCancelled.Value res -> - compensation () - - match res with - | Choice1Of2 r -> ValueOrCancelled.Value r - | Choice2Of2 err -> raise err - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - - member inline _.Return v = - Cancellable(fun _ -> ValueOrCancelled.Value v) - - member inline _.ReturnFrom(v: Cancellable<'T>) = v - - member inline _.Zero() = - Cancellable(fun _ -> ValueOrCancelled.Value()) - -[] -module CancellableAutoOpens = - let cancellable = CancellableBuilder() diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index aba96859491..a3c78cf7e8c 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -5,77 +5,13 @@ open System.Threading [] type Cancellable = + // For testing only. + static member internal SetTokenForTesting: CancellationToken -> unit 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 internal UsingToken: Async<'T> -> Async<'T> static member HasCancellationToken: bool static member Token: CancellationToken static member CheckAndThrow: unit -> unit static member TryCheckAndThrow: unit -> unit - -namespace Internal.Utilities.Library - -open System -open System.Threading - -[] -type internal ValueOrCancelled<'TResult> = - | Value of result: 'TResult - | Cancelled of ``exception``: OperationCanceledException - -/// Represents a synchronous, cold-start, cancellable computation with explicit representation of a cancelled result. -/// -/// A cancellable computation may be cancelled via a CancellationToken, which is propagated implicitly. -/// If cancellation occurs, it is propagated as data rather than by raising an OperationCanceledException. -[] -type internal Cancellable<'T> = Cancellable of (CancellationToken -> ValueOrCancelled<'T>) - -module internal Cancellable = - - /// Run a cancellable computation using the given cancellation token - val inline run: ct: CancellationToken -> Cancellable<'T> -> ValueOrCancelled<'T> - - val fold: f: ('State -> 'T -> Cancellable<'State>) -> acc: 'State -> seq: seq<'T> -> Cancellable<'State> - - /// Run the computation in a mode where it may not be cancelled. The computation never results in a - /// ValueOrCancelled.Cancelled. - val runWithoutCancellation: comp: Cancellable<'T> -> 'T - - /// Bind the cancellation token associated with the computation - val token: unit -> Cancellable - - val toAsync: Cancellable<'T> -> Async<'T> - -type internal CancellableBuilder = - - new: unit -> CancellableBuilder - - member inline BindReturn: comp: Cancellable<'T> * [] k: ('T -> 'U) -> Cancellable<'U> - - member inline Bind: comp: Cancellable<'T> * [] k: ('T -> Cancellable<'U>) -> Cancellable<'U> - - member inline Combine: comp1: Cancellable * comp2: Cancellable<'T> -> Cancellable<'T> - - member inline Delay: [] f: (unit -> Cancellable<'T>) -> Cancellable<'T> - - member inline Return: v: 'T -> Cancellable<'T> - - member inline ReturnFrom: v: Cancellable<'T> -> Cancellable<'T> - - member inline TryFinally: comp: Cancellable<'T> * [] compensation: (unit -> unit) -> Cancellable<'T> - - member inline TryWith: - comp: Cancellable<'T> * [] handler: (exn -> Cancellable<'T>) -> Cancellable<'T> - - member inline Using: - resource: 'Resource * [] comp: ('Resource -> Cancellable<'T>) -> Cancellable<'T> - when 'Resource :> IDisposable - - member inline Zero: unit -> Cancellable - -[] -module internal CancellableAutoOpens = - val cancellable: CancellableBuilder diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index 62e36de58b9..e6fe5c6c6b9 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -22,7 +22,7 @@ let mutable private wasCancelled = false let runCancelFirstTime f = let mutable requestCount = 0 fun () -> - use _ = Cancellable.UsingToken cts.Token + Cancellable.SetTokenForTesting cts.Token if requestCount = 0 then cts.Cancel() @@ -150,7 +150,7 @@ let referenceReaderProject getPreTypeDefs (cancelOnModuleAccess: bool) (options: let parseAndCheck path source options = cts <- new CancellationTokenSource() wasCancelled <- false - use _ = Cancellable.UsingToken cts.Token + Cancellable.SetTokenForTesting cts.Token try match Async.RunSynchronously(checker.ParseAndCheckFileInProject(path, 0, SourceText.ofString source, options), cancellationToken = cts.Token) with