Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Experiment: replace cancellable with async #18239

Closed
wants to merge 3 commits into from
Closed

Experiment: replace cancellable with async #18239

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
1227542
remove cancellable ce
majocha Jan 16, 2025
72edfa5
Merge branch 'main' into remove-cancellable
majocha Jan 17, 2025
259671f
Merge branch 'main' into remove-cancellable
majocha Jan 20, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
78 changes: 34 additions & 44 deletions src/Compiler/Checking/CheckDeclarations.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -4849,8 +4848,8 @@ module TcDeclarations =
// Bind module types
//-------------------------------------------------------------------------

let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Cancellable<TcEnv> =
cancellable {
let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async<TcEnv> =
async {
let g = cenv.g
try
match synSigDecl with
Expand Down Expand Up @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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....
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 [<TailCall>] 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 =
Expand All @@ -5492,17 +5492,14 @@ and [<TailCall>] 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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This does look a lot better now!

}


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
Expand All @@ -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)
}


Expand Down Expand Up @@ -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"
[|
Expand All @@ -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

Expand Down Expand Up @@ -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"
[|
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/CheckDeclarations.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ val CheckOneImplFile:
ModuleOrNamespaceType option *
ParsedImplFileInput *
FSharpDiagnosticOptions ->
Cancellable<TopAttribs * CheckedImplFile * TcEnv * bool>
Async<TopAttribs * CheckedImplFile * TcEnv * bool>

val CheckOneSigFile:
TcGlobals *
Expand All @@ -74,7 +74,7 @@ val CheckOneSigFile:
FSharpDiagnosticOptions ->
TcEnv ->
ParsedSigFileInput ->
Cancellable<TcEnv * ModuleOrNamespaceType * bool>
Async<TcEnv * ModuleOrNamespaceType * bool>

exception NotUpperCaseConstructor of range: range

Expand Down
20 changes: 11 additions & 9 deletions src/Compiler/Driver/ParseAndCheckInputs.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1312,8 +1312,8 @@ let CheckOneInput
tcSink: TcResultsSink,
tcState: TcState,
input: ParsedInput
) : Cancellable<PartialResult * TcState> =
cancellable {
) : Async<PartialResult * TcState> =
async {
try
use _ =
Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |]
Expand Down Expand Up @@ -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))
Expand All @@ -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) =
Expand All @@ -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
Expand Down Expand Up @@ -1530,8 +1531,8 @@ let CheckOneInputWithCallback
input: ParsedInput,
_skipImplIfSigExists: bool):
(unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
: Cancellable<Finisher<NodeToTypeCheck, TcState, PartialResult>> =
cancellable {
: Async<Finisher<NodeToTypeCheck, TcState, PartialResult>> =
async {
try
CheckSimulateException tcConfig

Expand Down Expand Up @@ -1905,7 +1906,8 @@ let CheckMultipleInputsUsingGraphMode
: Finisher<NodeToTypeCheck, State, PartialResult> =

let (Finisher(finisher = finisher)) =
cancellable {
async {
do! Cancellable.UseToken()
use _ = UseDiagnosticsLogger logger
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
let tcSink = TcResultsSink.NoSink
Expand All @@ -1915,7 +1917,7 @@ let CheckMultipleInputsUsingGraphMode
node
(checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, currentTcState, input, false)
}
|> Cancellable.runWithoutCancellation
|> Async.RunImmediate

Finisher(
node,
Expand Down
6 changes: 3 additions & 3 deletions src/Compiler/Driver/ParseAndCheckInputs.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand All @@ -196,7 +196,7 @@ val CheckOneInputWithCallback:
tcState: TcState *
input: ParsedInput *
_skipImplIfSigExists: bool ->
Cancellable<Finisher<NodeToTypeCheck, TcState, PartialResult>>
Async<Finisher<NodeToTypeCheck, TcState, PartialResult>>

val AddCheckResultsToTcState:
tcGlobals: TcGlobals *
Expand Down Expand Up @@ -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>
4 changes: 0 additions & 4 deletions src/Compiler/Facilities/DiagnosticsLogger.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -903,10 +903,6 @@ type StackGuard(maxDepth: int, name: string) =
finally
depth <- depth - 1

[<DebuggerHidden; DebuggerStepThrough>]
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
Expand Down
2 changes: 0 additions & 2 deletions src/Compiler/Facilities/DiagnosticsLogger.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -462,8 +462,6 @@ type StackGuard =
[<CallerLineNumber; Optional; DefaultParameterValue(0)>] 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.
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Interactive/fsi.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4809,7 +4809,7 @@ type FsiEvaluationSession

member _.ParseAndCheckInteraction(code) =
fsiInteractionProcessor.ParseAndCheckInteraction(legacyReferenceResolver, fsiInteractionProcessor.CurrentState, code)
|> Cancellable.runWithoutCancellation
|> Async.RunImmediate

member _.InteractiveChecker = checker

Expand Down
10 changes: 3 additions & 7 deletions src/Compiler/Service/BackgroundCompiler.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -747,7 +745,6 @@ type internal BackgroundCompiler
keepAssemblyContents,
suggestNamesForErrors
)
|> Cancellable.toAsync

GraphNode.SetPreferredUILang tcConfig.preferredUiLang
return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -1411,7 +1408,6 @@ type internal BackgroundCompiler

return options, (diags @ diagnostics.Diagnostics)
}
|> Cancellable.toAsync

member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) =
use _ =
Expand Down
Loading
Loading