propogate cancellation tokens to reactor queue

Author: dsyme

src/fsharp/vs/Reactor.fs

@@ -3,12 +3,13 @@
 namespace Microsoft.FSharp.Compiler.SourceCodeServices
 open System
 open System.Diagnostics
+open System.Threading
 open Microsoft.FSharp.Control
 open Microsoft.FSharp.Compiler.Lib
 
 // For internal use only 
 type internal IReactorOperations = 
-    abstract EnqueueAndAwaitOpAsync : string * (unit -> 'T) -> Async<'T>
+    abstract EnqueueAndAwaitOpAsync : string * (CancellationToken -> 'T) -> Async<'T>
     abstract EnqueueOp: string * (unit -> unit) -> unit
 
 module internal Reactor =
@@ -24,7 +25,7 @@ module internal Reactor =
         /// Do a bit of work on the given build.
         | Step                                                        
         /// Do some work not synchronized in the mailbox.
-        | Op of string * (unit -> unit) 
+        | Op of string * CancellationToken * (unit -> unit) * (unit -> unit)
         /// Stop building after finishing the current unit of work.
         | StopBackgroundOp of AsyncReplyChannel<ResultOrException<unit>>              
         /// Finish building.
@@ -178,15 +179,15 @@ module internal Reactor =
                                 //if span.TotalMilliseconds > 100.0 then 
                                 Debug.WriteLine("Reactor: <-- background step, remaining {0}, took {1}ms", inbox.CurrentQueueLength, span.TotalMilliseconds)
                                 res
-                            | Op (desc, op) -> 
+                            | Op (desc, ct, op, ccont) -> 
+                                if ct.IsCancellationRequested then ccont(); state else
                                 Debug.WriteLine("Reactor: --> {0}, remaining {1}, mem {2}, gc2 {3}", desc, inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
                                 let time = System.DateTime.Now
                                 let res = HandleOp op state
                                 let span = System.DateTime.Now - time
                                 //if span.TotalMilliseconds > 100.0 then 
                                 Debug.WriteLine("Reactor: <-- {0}, remaining {1}, took {2}ms", desc, inbox.CurrentQueueLength, span.TotalMilliseconds)
                                 res
-
                             | StopBackgroundOp channel -> 
                                 Debug.WriteLine("Reactor: --> stop background, remaining {0}, mem {1}, gc2 {2}", inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
                                 HandleStopBackgroundOp channel state
@@ -213,7 +214,11 @@ module internal Reactor =
 
         member r.EnqueueOp(desc, op) =
             Debug.WriteLine("Reactor: enqueue {0}, length {1}", desc, builder.CurrentQueueLength)
-            builder.Post(Op(desc, op)) 
+            builder.Post(Op(desc, CancellationToken.None, op, (fun () -> ()))) 
+
+        member r.EnqueueOpPrim(desc, ct, op, ccont) =
+            Debug.WriteLine("Reactor: enqueue {0}, length {1}", desc, builder.CurrentQueueLength)
+            builder.Post(Op(desc, ct, op, ccont)) 
 
         member r.CurrentQueueLength =
             builder.CurrentQueueLength
@@ -226,17 +231,22 @@ module internal Reactor =
             | Exception excn->raise excn
 
         member r.EnqueueAndAwaitOpAsync (desc, f) = 
-            let resultCell = AsyncUtil.AsyncResultCell<_>()
-            r.EnqueueOp(desc, 
-                fun () ->
-                    let result =
-                        try
-                            f () |> AsyncUtil.AsyncOk
-                        with
-                        |   e -> e |> AsyncUtil.AsyncException
-                    resultCell.RegisterResult(result)
-            )
-            resultCell.AsyncResult
+            async { 
+                let! ct = Async.CancellationToken
+                let resultCell = AsyncUtil.AsyncResultCell<_>()
+                r.EnqueueOpPrim(desc, ct,
+                    (fun () ->
+                        let result =
+                            try
+                                f ct |> AsyncUtil.AsyncOk
+                            with
+                            |   e -> e |> AsyncUtil.AsyncException
+                        resultCell.RegisterResult(result)),
+                     (fun () -> resultCell.RegisterResult (AsyncUtil.AsyncCanceled(OperationCanceledException())) )
+
+                )
+                return! resultCell.AsyncResult 
+            }
 
     let theReactor = Reactor()
     let Reactor() = theReactor

src/fsharp/vs/Reactor.fsi

@@ -2,11 +2,13 @@
 
 namespace Microsoft.FSharp.Compiler.SourceCodeServices
 
+open System.Threading
+
 // For internal use only 
 type internal IReactorOperations = 
 
     /// Put the operation in thq queue, and return an async handle to its result. 
-    abstract EnqueueAndAwaitOpAsync : description: string * action: (unit -> 'T) -> Async<'T>
+    abstract EnqueueAndAwaitOpAsync : description: string * action: (CancellationToken -> 'T) -> Async<'T>
 
     /// Enqueue an operation and return immediately. 
     abstract EnqueueOp: description: string * action: (unit -> unit) -> unit
@@ -32,7 +34,7 @@ module internal Reactor =
         /// Block until the current implicit background build is complete.
         member WaitForBackgroundOpCompletion : unit -> unit
 
-        /// Enqueue an operation and return immediately. 
+        /// Enqueue an uncancellable operation and return immediately. 
         member EnqueueOp : description: string * op:(unit -> unit) -> unit
 
         /// For debug purposes
@@ -43,7 +45,7 @@ module internal Reactor =
     // operation which can be halted part way through.
 
         /// Put the operation in thq queue, and return an async handle to its result. 
-        member EnqueueAndAwaitOpAsync : description: string * (unit -> 'T) -> Async<'T>
+        member EnqueueAndAwaitOpAsync : description: string * (CancellationToken -> 'T) -> Async<'T>
 
     /// Get the reactor for FSharp.Compiler.dll
     val Reactor : unit -> Reactor

src/fsharp/vs/service.fs

@@ -1911,7 +1911,7 @@ type FSharpCheckProjectResults(keepAssemblyContents, errors: FSharpErrorInfo[],
     member info.GetUsesOfSymbol(symbol:FSharpSymbol) = 
         let (tcGlobals, _tcImports, _thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr) = getDetails()
         // This probably doesn't need to be run on the reactor since all data touched by GetUsesOfSymbol is immutable.
-        reactorOps.EnqueueAndAwaitOpAsync("GetUsesOfSymbol", fun () -> 
+        reactorOps.EnqueueAndAwaitOpAsync("GetUsesOfSymbol", fun _ct -> 
             [| for r in tcSymbolUses do yield! r.GetUsesOfSymbol(symbol.Item) |] 
             |> Seq.distinctBy (fun (itemOcc,_denv,m) -> itemOcc, m) 
             |> Seq.map (fun (itemOcc,denv,m) -> FSharpSymbolUse(tcGlobals, denv, symbol, itemOcc, m)) 
@@ -1921,7 +1921,7 @@ type FSharpCheckProjectResults(keepAssemblyContents, errors: FSharpErrorInfo[],
     member info.GetAllUsesOfAllSymbols() = 
         let (tcGlobals, tcImports, thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr) = getDetails()
         // This probably doesn't need to be run on the reactor since all data touched by GetAllUsesOfSymbols is immutable.
-        reactorOps.EnqueueAndAwaitOpAsync("GetAllUsesOfAllSymbols", fun () -> 
+        reactorOps.EnqueueAndAwaitOpAsync("GetAllUsesOfAllSymbols", fun _ct -> 
             [| for r in tcSymbolUses do 
                   for (item,itemOcc,denv,m) in r.GetAllUsesOfSymbols() do
                     let symbol = FSharpSymbol.Create(tcGlobals, thisCcu, tcImports, item)
@@ -1984,7 +1984,7 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo
         | Some (scope, builderOpt, reactor) -> 
             // Ensure the builder doesn't get released while running operations asynchronously. 
             use _unwind = match builderOpt with Some builder -> builder.IncrementUsageCount() | None -> { new System.IDisposable with member __.Dispose() = () }
-            let! res = reactor.EnqueueAndAwaitOpAsync(desc, fun () ->  f scope)
+            let! res = reactor.EnqueueAndAwaitOpAsync(desc, fun _ct ->  f scope)
             return res
       }
 
@@ -2206,8 +2206,8 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     let reactorOps = 
         { new IReactorOperations with 
-                member __.EnqueueAndAwaitOpAsync (desc,op) = reactor.EnqueueAndAwaitOpAsync (desc,op)
-                member __.EnqueueOp (desc,op) = reactor.EnqueueOp (desc,op) }
+                member __.EnqueueAndAwaitOpAsync (desc, op) = reactor.EnqueueAndAwaitOpAsync (desc, op)
+                member __.EnqueueOp (desc, op) = reactor.EnqueueOp (desc, op) }
 
     // STATIC ROOT: LanguageServiceState.FSharpChecker.backgroundCompiler.scriptClosureCache 
     /// Information about the derived script closure.
@@ -2350,20 +2350,26 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
             foregroundTypeCheckCount <- foregroundTypeCheckCount + 1
             locked (fun () -> 
                 parseAndCheckFileInProjectCachePossiblyStale.Set((filename,options),(parseResults,typedResults,fileVersion))            
-                parseAndCheckFileInProjectCache.Set((filename,source,options),(parseResults,typedResults,fileVersion)))
+                parseAndCheckFileInProjectCache.Set((filename,source,options),(parseResults,typedResults,fileVersion))
+                parseFileInProjectCache.Set((filename,source,options),parseResults))
 
     /// Parses the source file and returns untyped AST
     member bc.ParseFileInProject(filename:string, source,options:FSharpProjectOptions) =
         match locked (fun () -> parseFileInProjectCache.TryGet (filename, source, options)) with 
         | Some res -> async.Return res
         | None -> 
-        reactor.EnqueueAndAwaitOpAsync("ParseFileInProject", fun () -> 
+        // Try this cache too (which might contain different entries)
+        let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
+        match cachedResults with 
+        | Some (parseResults, _checkResults,_) ->  async.Return parseResults
+        | _ -> 
+        reactor.EnqueueAndAwaitOpAsync("ParseFileInProject", fun _ct -> 
 
+            // Try the caches again - it may have been filled by the time this operation runs
             match locked (fun () -> parseFileInProjectCache.TryGet (filename, source, options)) with 
             | Some res -> res
             | None -> 
             let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
-            // We can use cached results when there is no work to do to bring the background builder up-to-date
             match cachedResults with 
             | Some (parseResults, _checkResults,_) ->  parseResults
             | _ -> 
@@ -2383,8 +2389,8 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API)
     member bc.GetBackgroundParseResultsForFileInProject(filename, options) =
-        reactor.EnqueueAndAwaitOpAsync("GetBackgroundParseResultsForFileInProject", fun () -> 
-            let builderOpt, creationErrors, _= getOrCreateBuilder options
+        reactor.EnqueueAndAwaitOpAsync("GetBackgroundParseResultsForFileInProject", fun _ct -> 
+            let builderOpt, creationErrors, _ = getOrCreateBuilder options
             match builderOpt with
             | None -> FSharpParseFileResults(List.toArray creationErrors, None, true, [])
             | Some builder -> 
@@ -2396,7 +2402,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
         )
 
     member bc.MatchBraces(filename:string, source, options)=
-        reactor.EnqueueAndAwaitOpAsync("MatchBraces", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync("MatchBraces", fun _ct -> 
             let builderOpt,_,_ = getOrCreateBuilder options
             match builderOpt with
             | None -> [| |]
@@ -2409,17 +2415,17 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. 
     member bc.CheckFileInProjectIfReady(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo:obj option) =
-        reactor.EnqueueAndAwaitOpAsync("CheckFileInProjectIfReady", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync("CheckFileInProjectIfReady", fun _ct -> 
           let checkAnswer = 
             match incrementalBuildersCache.TryGetAny options with
             | Some(Some builder, creationErrors, _) ->
 
-              let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
-              // We can use cached results when there is no work to do to bring the background builder up-to-date
-              match cachedResults with 
-              | Some (_parseResults, checkResults,_) when builder.AreCheckResultsBeforeFileInProjectReady(filename) ->  
-                  Some (FSharpCheckFileAnswer.Succeeded checkResults)
-              | _ -> 
+                // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date
+                let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
+                match cachedResults with 
+                | Some (_parseResults, checkResults,_) when builder.AreCheckResultsBeforeFileInProjectReady(filename) -> Some (FSharpCheckFileAnswer.Succeeded checkResults)
+                | _ -> 
+
                 match builder.GetCheckResultsBeforeFileInProjectIfReady filename with 
                 | Some(tcPrior) -> 
 
@@ -2441,18 +2447,18 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed.
     member bc.CheckFileInProject(parseResults:FSharpParseFileResults,filename,fileVersion,source,options,isResultObsolete,textSnapshotInfo) =
-        reactor.EnqueueAndAwaitOpAsync("CheckFileInProject", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync("CheckFileInProject", fun _ct -> 
             let builderOpt,creationErrors,_ = getOrCreateBuilder options
             match builderOpt with
             | None -> FSharpCheckFileAnswer.Succeeded (MakeCheckFileResultsEmpty(creationErrors))
             | Some builder -> 
-            let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
 
-            // We can use cached results when there is no work to do to bring the background builder up-to-date
+            // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date
+            let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
             match cachedResults with 
-            | Some (_parseResults, checkResults,_) when builder.AreCheckResultsBeforeFileInProjectReady(filename) ->  
-                FSharpCheckFileAnswer.Succeeded checkResults
+            | Some (_parseResults, checkResults,_) when builder.AreCheckResultsBeforeFileInProjectReady(filename) -> FSharpCheckFileAnswer.Succeeded checkResults
             | _ -> 
+
             let tcPrior = builder.GetCheckResultsBeforeFileInProject filename 
             let loadClosure = scriptClosureCache.TryGet options 
             let tcErrors, tcFileResult = 
@@ -2465,16 +2471,16 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Parses the source file and returns untyped AST
     member bc.ParseAndCheckFileInProject(filename:string, fileVersion, source, options:FSharpProjectOptions,isResultObsolete,textSnapshotInfo) =
-        reactor.EnqueueAndAwaitOpAsync("ParseAndCheckFileInProjectPartB", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync("ParseAndCheckFileInProject", fun _ct -> 
             let builderOpt,creationErrors,_ = getOrCreateBuilder options // Q: Whis it it ok to ignore creationErrors in the build cache? A: These errors will be appended into the typecheck results
             match builderOpt with
             | None -> 
                 let parseResults = FSharpParseFileResults(List.toArray creationErrors, None, true, [])
                 (parseResults, FSharpCheckFileAnswer.Aborted)
             | Some builder -> 
-                let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
 
-                // We can use cached results when there is no work to do to bring the background builder up-to-date
+                // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date
+                let cachedResults = locked (fun () -> parseAndCheckFileInProjectCache.TryGet((filename,source,options)))
                 match cachedResults with 
                 | Some (parseResults, checkResults,_) when builder.AreCheckResultsBeforeFileInProjectReady(filename) ->  
                    parseResults, FSharpCheckFileAnswer.Succeeded checkResults
@@ -2496,7 +2502,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API)
     member bc.GetBackgroundCheckResultsForFileInProject(filename,options) =
-        reactor.EnqueueAndAwaitOpAsync("GetBackgroundCheckResultsForFileInProject", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync("GetBackgroundCheckResultsForFileInProject", fun _ct -> 
             let (builderOpt, creationErrors, _) = getOrCreateBuilder options 
             match builderOpt with
             | None -> 
@@ -2550,10 +2556,10 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     /// Parse and typecheck the whole project.
     member bc.ParseAndCheckProject(options) =
-        reactor.EnqueueAndAwaitOpAsync("ParseAndCheckProject", fun () -> bc.ParseAndCheckProjectImpl(options))
+        reactor.EnqueueAndAwaitOpAsync("ParseAndCheckProject", fun _ct -> bc.ParseAndCheckProjectImpl(options))
 
     member bc.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib) = 
-        reactor.EnqueueAndAwaitOpAsync ("GetProjectOptionsFromScript", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync ("GetProjectOptionsFromScript", fun _ct -> 
             // Do we add a reference to FSharp.Compiler.Interactive.Settings by default?
             let useFsiAuxLib = defaultArg useFsiAuxLib true
             // Do we use a "FSharp.Core, 4.3.0.0" reference by default?
@@ -2630,7 +2636,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
     member bc.CurrentQueueLength = reactor.CurrentQueueLength
 
     member bc.ClearCaches() =
-        reactor.EnqueueAndAwaitOpAsync ("ClearCaches", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync ("ClearCaches", fun _ct -> 
             locked (fun () -> 
                 parseAndCheckFileInProjectCachePossiblyStale.Clear()
                 parseAndCheckFileInProjectCache.Clear()
@@ -2640,7 +2646,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
             scriptClosureCache.Clear())
 
     member bc.DownsizeCaches() =
-        reactor.EnqueueAndAwaitOpAsync ("DownsizeCaches", fun () -> 
+        reactor.EnqueueAndAwaitOpAsync ("DownsizeCaches", fun _ct -> 
             locked (fun () -> 
                 parseAndCheckFileInProjectCachePossiblyStale.Resize(keepStrongly=1)
                 parseAndCheckFileInProjectCache.Resize(keepStrongly=1)