add pause before background work

Author: dsyme

docs/content/queue.fsx

@@ -11,11 +11,12 @@ sequentially and in order.
 
 The thread processing these requests can also run a low-priority, interleaved background operation when the
 queue is empty.  This can be used to implicitly bring the background check of a project "up-to-date".  
-When the operations queue is empty this background work is run in small incremental fragments. 
-This work is cooperatively time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in 
+When the operations queue has been empty for 1 second , 
+this background work is run in small incremental fragments. This work is cooperatively time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in 
 IncrementalBuild.fs). The project to be checked in the background is set implicitly 
 by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``.
 To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false.
+To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required number of milliseconds.
 
 Most calls to the FSharpChecker API enqueue an operation in the FSharpChecker compiler queue. These correspond to the 
 calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/vs/service.fs).

src/fsharp/vs/IncrementalBuild.fs

@@ -1080,7 +1080,7 @@ module internal IncrementalFSharpBuild =
 #if SILVERLIGHT
         50L
 #else
-        match System.Environment.GetEnvironmentVariable("mFSharp_MaxTimeShare") with 
+        match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with 
         | null | "" -> 50L
         | s -> int64 s
 #endif

src/fsharp/vs/Reactor.fs

@@ -30,6 +30,10 @@ module internal Reactor =
      /// There is one global Reactor for the entire language service, no matter how many projects or files
      /// are open. 
      type Reactor() = 
+        static let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt
+        static let pauseBeforeBackgroundWorkDefault = GetEnvInteger "FCS_PauseBeforeBackgroundWorkMilliseconds" 1000
+        let mutable pauseBeforeBackgroundWork = pauseBeforeBackgroundWorkDefault
+
         // We need to store the culture for the VS thread that is executing now,
         // so that when the reactor picks up a thread from the threadpool we can set the culture
         let culture = new CultureInfo(Thread.CurrentThread.CurrentUICulture.LCID)
@@ -38,22 +42,27 @@ module internal Reactor =
         let builder = 
           MailboxProcessor<_>.Start <| fun inbox ->        
 
-
             // Async workflow which receives messages and dispatches to worker functions.
-            let rec loop (bgOpOpt, onComplete) = 
+            let rec loop (bgOpOpt, onComplete, bg) = 
                 async { Debug.WriteLine("Reactor: receiving..., remaining {0}, mem {1}, gc2 {2}", inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
 
                         // Messages always have priority over the background op.
                         let! msg = 
                             async { match bgOpOpt, onComplete with 
-                                    | None, None -> let! msg = inbox.Receive() in return Some msg 
-                                    | _ -> return! inbox.TryReceive(0) }
+                                    | None, None -> 
+                                       let! msg = inbox.Receive() 
+                                       return Some msg 
+                                    | _, Some _ -> 
+                                       return! inbox.TryReceive(0) 
+                                    | Some _, _ -> 
+                                       let timeout = (if bg then 0 else pauseBeforeBackgroundWork)
+                                       return! inbox.TryReceive(timeout) }
                         Thread.CurrentThread.CurrentUICulture <- culture
 
                         match msg with
                         | Some (SetBackgroundOp bgOpOpt) -> 
                             Debug.WriteLine("Reactor: --> set background op, remaining {0}, mem {1}, gc2 {2}", inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
-                            return! loop (bgOpOpt, onComplete)
+                            return! loop (bgOpOpt, onComplete, false)
                         | Some (Op (desc, ct, op, ccont)) -> 
                             if ct.IsCancellationRequested then ccont() else
                             Debug.WriteLine("Reactor: --> {0}, remaining {1}, mem {2}, gc2 {3}", desc, inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
@@ -62,17 +71,17 @@ module internal Reactor =
                             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)
-                            return! loop (bgOpOpt, onComplete)
+                            return! loop (bgOpOpt, onComplete, false)
                         | Some (WaitForBackgroundOpCompletion channel) -> 
                             Debug.WriteLine("Reactor: --> wait for background (debug only), remaining {0}, mem {1}, gc2 {2}", inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
                             match bgOpOpt with 
                             | None -> ()
                             | Some bgOp -> while bgOp() do ()
                             channel.Reply(())
-                            return! loop (None, onComplete)
+                            return! loop (None, onComplete, false)
                         | Some (CompleteAllQueuedOps channel) -> 
                             Debug.WriteLine("Reactor: --> stop background work and complete all queued ops, remaining {0}, mem {1}, gc2 {2}", inbox.CurrentQueueLength, GC.GetTotalMemory(false)/1000000L, GC.CollectionCount(2))
-                            return! loop (None, Some channel)
+                            return! loop (None, Some channel, false)
                         | None -> 
                             match bgOpOpt, onComplete with 
                             | _, Some onComplete -> onComplete.Reply()
@@ -83,13 +92,13 @@ module internal Reactor =
                                 let span = System.DateTime.Now - time
                                 //if span.TotalMilliseconds > 100.0 then 
                                 Debug.WriteLine("Reactor: <-- background step, remaining {0}, took {1}ms", inbox.CurrentQueueLength, span.TotalMilliseconds)
-                                return! loop ((if res then Some bgOp else None), onComplete)
+                                return! loop ((if res then Some bgOp else None), onComplete, true)
                             | None, None -> failwith "unreachable, should have used inbox.Receive"
                       }
             async { 
                 while true do 
                     try 
-                        do! loop (None, None)
+                        do! loop (None, None, false)
                     with e -> 
                         Debug.Assert(false,String.Format("unexpected failure in reactor loop {0}, restarting", e))
             }
@@ -138,6 +147,7 @@ module internal Reactor =
                 )
                 return! resultCell.AsyncResult 
             }
+        member __.PauseBeforeBackgroundWork with get() = pauseBeforeBackgroundWork and set v = pauseBeforeBackgroundWork <- v
 
     let theReactor = Reactor()
     let Reactor() = theReactor

src/fsharp/vs/Reactor.fsi

@@ -43,6 +43,8 @@ module internal Reactor =
         /// Put the operation in the queue, and return an async handle to its result. 
         member EnqueueAndAwaitOpAsync : description: string * (CancellationToken -> 'T) -> Async<'T>
 
+        member PauseBeforeBackgroundWork : int with get, set
+
     /// Get the reactor for FSharp.Compiler.dll
     val Reactor : unit -> Reactor
   

src/fsharp/vs/ServiceDeclarations.fs

@@ -40,11 +40,11 @@ module EnvMisc2 =
 #else
     let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt
 #endif
-    let maxMembers   = GetEnvInteger "mFSharp_MaxMembersInQuickInfo" 10
+    let maxMembers   = GetEnvInteger "FCS_MaxMembersInQuickInfo" 10
 
     /// dataTipSpinWaitTime limits how long we block the UI thread while a tooltip pops up next to a selected item in an IntelliSense completion list.
     /// This time appears to be somewhat amortized by the time it takes the VS completion UI to actually bring up the tooltip after selecting an item in the first place.
-    let dataTipSpinWaitTime = GetEnvInteger "mFSharp_ToolTipSpinWaitTime" 300
+    let dataTipSpinWaitTime = GetEnvInteger "FCS_ToolTipSpinWaitTime" 300
 
 //----------------------------------------------------------------------------
 // Display characteristics of typechecking items

src/fsharp/vs/service.fs

@@ -49,21 +49,17 @@ open ItemDescriptionsImpl
 
 [<AutoOpen>]
 module EnvMisc =
-#if SILVERLIGHT
-    let GetEnvInteger e dflt = dflt
-#else
     let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt
-#endif
-    let getToolTipTextSize = GetEnvInteger "mFSharp_RecentForegroundTypeCheckCacheSize" 5
-    let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "mFSharp_MaxErrorsOutOfProjectContext" 3
-    let braceMatchCacheSize = GetEnvInteger "mFSharp_BraceMatchCacheSize" 5
-    let parseFileInProjectCacheSize = GetEnvInteger "mFSharp_ParseFileInProjectCacheSize" 2
-    let incrementalTypeCheckCacheSize = GetEnvInteger "mFSharp_IncrementalTypeCheckCacheSize" 5
+    let getToolTipTextSize = GetEnvInteger "FCS_RecentForegroundTypeCheckCacheSize" 5
+    let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3
+    let braceMatchCacheSize = GetEnvInteger "FCS_BraceMatchCacheSize" 5
+    let parseFileInProjectCacheSize = GetEnvInteger "FCS_ParseFileInProjectCacheSize" 2
+    let incrementalTypeCheckCacheSize = GetEnvInteger "FCS_IncrementalTypeCheckCacheSize" 5
 
-    let projectCacheSizeDefault   = GetEnvInteger "mFSharp_ProjectCacheSizeDefault" 3
-    let frameworkTcImportsCacheStrongSize = GetEnvInteger "mFSharp_frameworkTcImportsCacheStrongSizeDefault" 8
-    let maxMBDefault =  GetEnvInteger "mFSharp_maxMB" 1000000 // a million MB = 1TB = disabled
-    //let maxMBDefault = GetEnvInteger "mFSharp_maxMB" (if sizeof<int> = 4 then 1700 else 3400)
+    let projectCacheSizeDefault   = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3
+    let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8
+    let maxMBDefault =  GetEnvInteger "FCS_MaxMB" 1000000 // a million MB = 1TB = disabled
+    //let maxMBDefault = GetEnvInteger "FCS_maxMB" (if sizeof<int> = 4 then 1700 else 3400)
 
 //----------------------------------------------------------------------------
 // Methods
@@ -2663,6 +2659,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     member __.FrameworkImportsCache = frameworkTcImportsCache
     member __.ImplicitlyStartBackgroundWork with get() = implicitlyStartBackgroundWork and set v = implicitlyStartBackgroundWork <- v
+    member __.PauseBeforeBackgroundWork with get() = Reactor.Reactor().PauseBeforeBackgroundWork and set v = Reactor.Reactor().PauseBeforeBackgroundWork <- v
     static member GlobalForegroundParseCountStatistic = foregroundParseCount
     static member GlobalForegroundTypeCheckCountStatistic = foregroundTypeCheckCount