WIP Async2

src/Compiler/Checking/CheckDeclarations.fs

@@ -4868,9 +4868,9 @@ module TcDeclarations =
 //-------------------------------------------------------------------------
 // Bind module types
 //------------------------------------------------------------------------- 
-
-let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Cancellable<TcEnv> =
-  cancellable {
+#nowarn 3511
+let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcEnv) synSigDecl: Async2<TcEnv> =
+  async2 {
     let g = cenv.g
     try 
         match synSigDecl with 
@@ -5019,14 +5019,14 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
 
             return env
 
-    with RecoverableException exn -> 
+    with exn -> 
         errorRecovery exn endm 
         return env
   }
 
 
 and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs = 
-    cancellable {
+    async2 {
         // Ensure the .Deref call in UpdateAccModuleOrNamespaceType succeeds 
         if cenv.compilingCanonicalFslibModuleType then
             let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
@@ -5042,10 +5042,16 @@ 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
+    async2 {
+        match defs with
+        | [] -> return env
+        | def :: rest ->
+            let! env = TcSignatureElementNonMutRec cenv parent typeNames endm env def
+            return! TcSignatureElementsNonMutRec cenv parent typeNames endm env rest
+    }
 
 and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (defs: SynModuleSigDecl list) =
-    cancellable {
+    async2 {
         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) 
 
@@ -5100,7 +5106,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d
 
 and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, moduleKind, defs, m: range, xml) =
 
-  cancellable {
+  async2 {
     let endm = m.EndRange // use end of range for errors 
 
     // Create the module type that will hold the results of type checking.... 
@@ -5258,7 +5264,7 @@ let TcModuleOrNamespaceElementsMutRec (cenv: cenv) parent typeNames m envInitial
 
 /// The non-mutually recursive case for a declaration
 let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl =   
-  cancellable {
+  async2 {
     let g = cenv.g
     cenv.synArgNameGenerator.Reset()
     let tpenv = emptyUnscopedTyparEnv
@@ -5369,7 +5375,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
@@ -5461,7 +5466,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 = 
@@ -5491,20 +5495,17 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
           return 
               (defns, [], topAttrs), env, envAtEnd
 
-    with RecoverableException exn -> 
+    with exn -> 
         errorRecovery exn synDecl.Range 
         return ([], [], []), env, env
  }
 
 /// 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 ct)
-    else
+and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) =
+    async2 {
         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 =
@@ -5513,17 +5514,12 @@ 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)
-
-            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 {
+  async2 {
     // Ensure the deref_nlpath call in UpdateAccModuleOrNamespaceType succeeds 
     if cenv.compilingCanonicalFslibModuleType then
         let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
@@ -5545,21 +5541,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)
   }
 
 
@@ -5771,7 +5761,7 @@ let CheckOneImplFile
     let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, _, implFileFrags, isLastCompiland, _, _)) = synImplFile
     let infoReader = InfoReader(g, amap)
 
-    cancellable {
+    async2 {
         use _ =
             Activity.start "CheckDeclarations.CheckOneImplFile"
                 [|
@@ -5796,7 +5786,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
 
@@ -5916,7 +5905,7 @@ let CheckOneImplFile
 
 /// Check an entire signature file
 let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) =
- cancellable {     
+ async2 {     
     use _ =
         Activity.start "CheckDeclarations.CheckOneSigFile"
             [|
@@ -5947,7 +5936,7 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin
         try
             sigFileType |> IterTyconsOfModuleOrNamespaceType (fun tycon ->
                 FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv, tycon))
-        with RecoverableException exn -> errorRecovery exn sigFile.QualifiedName.Range
+        with exn -> errorRecovery exn sigFile.QualifiedName.Range
 
     UpdatePrettyTyparNames.updateModuleOrNamespaceType sigFileType
 

src/Compiler/Checking/CheckDeclarations.fsi

@@ -60,7 +60,7 @@ val CheckOneImplFile:
     ModuleOrNamespaceType option *
     ParsedImplFileInput *
     FSharpDiagnosticOptions ->
-        Cancellable<TopAttribs * CheckedImplFile * TcEnv * bool>
+        Async2<TopAttribs * CheckedImplFile * TcEnv * bool>
 
 val CheckOneSigFile:
     TcGlobals *
@@ -73,7 +73,7 @@ val CheckOneSigFile:
     FSharpDiagnosticOptions ->
         TcEnv ->
         ParsedSigFileInput ->
-            Cancellable<TcEnv * ModuleOrNamespaceType * bool>
+            Async2<TcEnv * ModuleOrNamespaceType * bool>
 
 exception NotUpperCaseConstructor of range: range
 

src/Compiler/Driver/CompilerConfig.fs

@@ -296,7 +296,7 @@ and IProjectReference =
     abstract FileName: string
 
     /// Evaluate raw contents of the assembly file generated by the project
-    abstract EvaluateRawContents: unit -> Async<ProjectAssemblyDataResult>
+    abstract EvaluateRawContents: unit -> Async2<ProjectAssemblyDataResult>
 
     /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project
     ///

src/Compiler/Driver/CompilerConfig.fsi

@@ -19,7 +19,6 @@ open FSharp.Compiler.Features
 open FSharp.Compiler.CodeAnalysis
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
-open FSharp.Compiler.BuildGraph
 
 exception FileNameNotResolved of searchedLocations: string * fileName: string * range: range
 
@@ -89,7 +88,7 @@ and IProjectReference =
     /// Evaluate raw contents of the assembly file generated by the project.
     /// 'None' may be returned if an in-memory view of the contents is, for some reason,
     /// not available.  In this case the on-disk view of the contents will be preferred.
-    abstract EvaluateRawContents: unit -> Async<ProjectAssemblyDataResult>
+    abstract EvaluateRawContents: unit -> Async2<ProjectAssemblyDataResult>
 
     /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project.
     ///

src/Compiler/Driver/CompilerImports.fs

@@ -2249,14 +2249,14 @@ and [<Sealed>] TcImports
     // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable.
     member tcImports.TryRegisterAndPrepareToImportReferencedDll
         (ctok, r: AssemblyResolution)
-        : Async<(_ * (unit -> AvailableImportedAssembly list)) option> =
-        async {
+        : Async2<(_ * (unit -> AvailableImportedAssembly list)) option> =
+        async2 {
             CheckDisposed()
             let m = r.originalReference.Range
             let fileName = r.resolvedPath
 
             let! contentsOpt =
-                async {
+                async2 {
                     match r.ProjectReference with
                     | Some ilb -> return! ilb.EvaluateRawContents()
                     | None -> return ProjectAssemblyDataResult.Unavailable true
@@ -2319,7 +2319,7 @@ and [<Sealed>] TcImports
 
     // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable.
     member tcImports.RegisterAndImportReferencedAssemblies(ctok, nms: AssemblyResolution list) =
-        async {
+        async2 {
             CheckDisposed()
 
             let tcConfig = tcConfigP.Get ctok
@@ -2332,7 +2332,7 @@ and [<Sealed>] TcImports
             let! results =
                 nms
                 |> List.map (fun nm ->
-                    async {
+                    async2 {
                         try
                             use _ = new CompilationGlobalsScope()
                             return! tcImports.TryRegisterAndPrepareToImportReferencedDll(ctok, nm)
@@ -2376,7 +2376,7 @@ and [<Sealed>] TcImports
                     ReportWarnings warns
 
                     tcImports.RegisterAndImportReferencedAssemblies(ctok, res)
-                    |> Async.RunImmediate
+                    |> Async2.RunImmediate
                     |> ignore
 
                     true
@@ -2466,7 +2466,7 @@ and [<Sealed>] TcImports
     // we dispose TcImports is because we need to dispose type providers, and type providers are never included in the framework DLL set.
     // If a framework set ever includes type providers, you will not have to worry about explicitly calling Dispose as the Finalizer will handle it.
     static member BuildFrameworkTcImports(tcConfigP: TcConfigProvider, frameworkDLLs, nonFrameworkDLLs) =
-        async {
+        async2 {
             let ctok = CompilationThreadToken()
             let tcConfig = tcConfigP.Get ctok
 
@@ -2543,7 +2543,7 @@ and [<Sealed>] TcImports
                 resolvedAssemblies |> List.choose tryFindEquivPrimaryAssembly
 
             let! fslibCcu, fsharpCoreAssemblyScopeRef =
-                async {
+                async2 {
                     if tcConfig.compilingFSharpCore then
                         // When compiling FSharp.Core.dll, the fslibCcu reference to FSharp.Core.dll is a delayed ccu thunk fixed up during type checking
                         return CcuThunk.CreateDelayed getFSharpCoreLibraryName, ILScopeRef.Local
@@ -2634,7 +2634,7 @@ and [<Sealed>] TcImports
         (tcConfigP: TcConfigProvider, baseTcImports, nonFrameworkReferences, knownUnresolved, dependencyProvider)
         =
 
-        async {
+        async2 {
             let ctok = CompilationThreadToken()
             let tcConfig = tcConfigP.Get ctok
 
@@ -2652,7 +2652,7 @@ and [<Sealed>] TcImports
         }
 
     static member BuildTcImports(tcConfigP: TcConfigProvider, dependencyProvider) =
-        async {
+        async2 {
             let ctok = CompilationThreadToken()
             let tcConfig = tcConfigP.Get ctok
 
@@ -2684,7 +2684,7 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso
 
     let ccuinfos =
         tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions)
-        |> Async.RunImmediate
+        |> Async2.RunImmediate
 
     let asms =
         ccuinfos

src/Compiler/Driver/CompilerImports.fsi

@@ -206,14 +206,14 @@ type TcImports =
     member internal Base: TcImports option
 
     static member BuildFrameworkTcImports:
-        TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Async<TcGlobals * TcImports>
+        TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Async2<TcGlobals * TcImports>
 
     static member BuildNonFrameworkTcImports:
         TcConfigProvider * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list * DependencyProvider ->
-            Async<TcImports>
+            Async2<TcImports>
 
     static member BuildTcImports:
-        tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> Async<TcGlobals * TcImports>
+        tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> Async2<TcGlobals * TcImports>
 
 /// Process a group of #r in F# Interactive.
 /// Adds the reference to the tcImports and add the ccu to the type checking environment.