add memory threshold

Author: dsyme

src/fsharp/InternalCollections.fs

@@ -20,6 +20,7 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
     /// The choice of order is somewhat arbitrary. If the other way then adding
     /// items would be O(1) and removing O(N).
     let mutable refs:('TKey*ValueStrength<'TValue>) list = [] 
+    let mutable keepStrongly = keepStrongly
 
     // Only set a strong discard function if keepMax is explicitly set to keepStrongly, i.e. there are no weak entries in this lookup.
     do assert (onStrongDiscard.IsNone || Some keepStrongly = keepMax)
@@ -30,7 +31,7 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
     // references. Some operations are O(N) and we don't want to let things get out of
     // hand.
     let keepMax = defaultArg keepMax 75 
-    let keepMax = max keepStrongly keepMax 
+    let mutable keepMax = max keepStrongly keepMax 
 
     /// Look up a the given key, return None if not found.
     let TryPeekKeyValueImpl(data,key) = 
@@ -140,6 +141,14 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
        let discards = FilterAndHold()
        AssignWithStrength([], discards)
 
+    member al.Resize(newKeepStrongly, ?newKeepMax) =
+       let newKeepMax = defaultArg newKeepMax 75 
+       keepStrongly <- newKeepStrongly
+       keepMax <- max newKeepStrongly newKeepMax
+       do assert (onStrongDiscard.IsNone || keepStrongly = keepMax)
+       let keep = FilterAndHold()
+       AssignWithStrength(keep, [])
+
 
 
 type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly, areSame, ?isStillValid : 'TKey*'TValue->bool, ?areSameForSubsumption, ?onStrongDiscard, ?keepMax) =
@@ -178,6 +187,9 @@ type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly, ar
     member bc.Clear() =
         cache.Clear()
 
+    member bc.Resize(newKeepStrongly, ?newKeepMax) =
+        cache.Resize(newKeepStrongly, ?newKeepMax=newKeepMax)
+        
 /// List helpers
 [<Sealed>]
 type internal List = 

src/fsharp/InternalCollections.fsi

@@ -27,6 +27,8 @@ namespace Internal.Utilities.Collections
     member Remove : key:'TKey -> unit
     /// Remove all elements.
     member Clear : unit -> unit
+    /// Resize
+    member Resize : keepStrongly: int * ?keepMax : int -> unit
     
   /// Simple priority caching for a small number of key\value associations.
   /// This cache may age-out results that have been Set by the caller.
@@ -50,6 +52,8 @@ namespace Internal.Utilities.Collections
     member Remove : key:'TKey -> unit
     /// Set the given key. 
     member Set : key:'TKey * value:'TValue -> unit
+    /// Resize
+    member Resize : keepStrongly: int * ?keepMax : int -> unit
 
   [<Sealed>]
   type internal List = 

src/fsharp/fsi/fsi.fs

@@ -2362,10 +2362,11 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i
 
     let fsiConsoleInput = FsiConsoleInput(fsi, fsiOptions, inReader, outWriter)
 
+    let frameworkImportsCache = IncrementalFSharpBuild.FrameworkImportsCache(1)
     let (tcGlobals,frameworkTcImports,nonFrameworkResolutions,unresolvedReferences) = 
         try 
             let tcConfig = tcConfigP.Get()
-            IncrementalFSharpBuild.GetFrameworkTcImports tcConfig
+            frameworkImportsCache.Get tcConfig
         with e -> 
             stopProcessingRecovery e range0; failwithf "Error creating evaluation session: %A" e
 

src/fsharp/vs/IncrementalBuild.fs

@@ -1087,10 +1087,14 @@ module internal IncrementalFSharpBuild =
 
     /// Global service state
     type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*ClrRoot*)string list* (*fsharpBinaries*)string
-    let private frameworkTcImportsCache = AgedLookup<FrameworkImportsCacheKey,(TcGlobals * TcImports)>(8, areSame=(fun (x,y) -> x = y)) 
-    let ClearFrameworkTcImportsCache() = frameworkTcImportsCache.Clear()
-    /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them.
-    let GetFrameworkTcImports(tcConfig:TcConfig) =
+
+    type FrameworkImportsCache(keepStrongly) = 
+      let frameworkTcImportsCache = AgedLookup<FrameworkImportsCacheKey,(TcGlobals * TcImports)>(keepStrongly, areSame=(fun (x,y) -> x = y)) 
+      member __.Downsize() = frameworkTcImportsCache.Resize(keepStrongly=0)
+      member __.Clear() = frameworkTcImportsCache.Clear()
+
+      /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them.
+      member __.Get(tcConfig:TcConfig) =
         // Split into installed and not installed.
         let frameworkDLLs,nonFrameworkResolutions,unresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig)
         let frameworkDLLsKey = 
@@ -1188,7 +1192,7 @@ module internal IncrementalFSharpBuild =
         TimeStamp = timestamp }
 
 
-    type IncrementalBuilder(tcConfig : TcConfig, projectDirectory, outfile, assemblyName, niceNameGen : Ast.NiceNameGenerator, lexResourceManager,
+    type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig : TcConfig, projectDirectory, outfile, assemblyName, niceNameGen : Ast.NiceNameGenerator, lexResourceManager,
                             sourceFiles, projectReferences: IProjectReference list, ensureReactive, 
                             keepAssemblyContents, keepAllBackgroundResolutions) =
 
@@ -1202,7 +1206,7 @@ module internal IncrementalFSharpBuild =
         // Resolve assemblies and create the framework TcImports. This is done when constructing the
         // builder itself, rather than as an incremental task. This caches a level of "system" references. No type providers are 
         // included in these references. 
-        let (tcGlobals,frameworkTcImports,nonFrameworkResolutions,unresolvedReferences) = GetFrameworkTcImports tcConfig
+        let (tcGlobals,frameworkTcImports,nonFrameworkResolutions,unresolvedReferences) = frameworkTcImportsCache.Get tcConfig
 
         // Check for the existence of loaded sources and prepend them to the sources list if present.
         let sourceFiles = tcConfig.GetAvailableLoadedSources() @ (sourceFiles |>List.map(fun s -> rangeStartup,s))
@@ -1723,7 +1727,7 @@ module internal IncrementalFSharpBuild =
 
         /// CreateIncrementalBuilder (for background type checking). Note that fsc.fs also
         /// creates an incremental builder used by the command line compiler.
-        static member TryCreateBackgroundBuilderForProjectOptions (scriptClosureOptions:LoadClosure option, sourceFiles:string list, commandLineArgs:string list, projectReferences, projectDirectory, useScriptResolutionRules, isIncompleteTypeCheckEnvironment, keepAssemblyContents, keepAllBackgroundResolutions) =
+        static member TryCreateBackgroundBuilderForProjectOptions (frameworkTcImportsCache, scriptClosureOptions:LoadClosure option, sourceFiles:string list, commandLineArgs:string list, projectReferences, projectDirectory, useScriptResolutionRules, isIncompleteTypeCheckEnvironment, keepAssemblyContents, keepAllBackgroundResolutions) =
 
           // Trap and report warnings and errors from creation.
           use errorScope = new ErrorScope()
@@ -1800,7 +1804,8 @@ module internal IncrementalFSharpBuild =
                 let outfile, _, assemblyName = tcConfigB.DecideNames sourceFilesNew
 
                 let builder = 
-                    new IncrementalBuilder(tcConfig, projectDirectory, outfile, assemblyName, niceNameGen,
+                    new IncrementalBuilder(frameworkTcImportsCache,
+                                           tcConfig, projectDirectory, outfile, assemblyName, niceNameGen,
                                            resourceManager, sourceFilesNew, projectReferences, ensureReactive=true, 
                                            keepAssemblyContents=keepAssemblyContents, 
                                            keepAllBackgroundResolutions=keepAllBackgroundResolutions)

src/fsharp/vs/IncrementalBuild.fsi

@@ -49,8 +49,11 @@ type internal ErrorScope =
 module internal IncrementalFSharpBuild =
 
   /// Lookup the global static cache for building the FrameworkTcImports
-  val GetFrameworkTcImports : TcConfig -> TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list
-  val ClearFrameworkTcImportsCache: unit -> unit
+  type FrameworkImportsCache = 
+      new : size: int -> FrameworkImportsCache
+      member Get : TcConfig -> TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list
+      member Clear: unit -> unit
+      member Downsize: unit -> unit
   
   type PartialCheckResults = 
       { TcState : TcState 
@@ -149,7 +152,7 @@ module internal IncrementalFSharpBuild =
       /// This may be a marginally long-running operation (parses are relatively quick, only one file needs to be parsed)
       member GetParseResultsForFile : filename:string -> Ast.ParsedInput option * Range.range * string * (PhasedError * FSharpErrorSeverity) list
 
-      static member TryCreateBackgroundBuilderForProjectOptions : scriptClosureOptions:LoadClosure option * sourceFiles:string list * commandLineArgs:string list * projectReferences: IProjectReference list * projectDirectory:string * useScriptResolutionRules:bool * isIncompleteTypeCheckEnvironment : bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool -> IncrementalBuilder option * FSharpErrorInfo list 
+      static member TryCreateBackgroundBuilderForProjectOptions : FrameworkImportsCache * scriptClosureOptions:LoadClosure option * sourceFiles:string list * commandLineArgs:string list * projectReferences: IProjectReference list * projectDirectory:string * useScriptResolutionRules:bool * isIncompleteTypeCheckEnvironment : bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool -> IncrementalBuilder option * FSharpErrorInfo list 
 
 [<Obsolete("This type has been renamed to FSharpErrorInfo")>]
 /// Renamed to FSharpErrorInfo

src/fsharp/vs/service.fs

@@ -61,6 +61,8 @@ module EnvMisc =
     let incrementalTypeCheckCacheSize = GetEnvInteger "mFSharp_IncrementalTypeCheckCacheSize" 5
 
     let projectCacheSizeDefault   = GetEnvInteger "mFSharp_ProjectCacheSizeDefault" 3
+    let frameworkTcImportsCacheStrongSize = GetEnvInteger "mFSharp_frameworkTcImportsCacheStrongSizeDefault" 8
+    let maxMBDefault = GetEnvInteger "mFSharp_maxMB" 2000
 
 //----------------------------------------------------------------------------
 // Methods
@@ -2184,6 +2186,8 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
             areSame=FSharpProjectOptions.AreSameForChecking, 
             areSameForSubsumption=FSharpProjectOptions.AreSubsumable)
 
+    let frameworkTcImportsCache = IncrementalFSharpBuild.FrameworkImportsCache(frameworkTcImportsCacheStrongSize)
+
     /// CreateOneIncrementalBuilder (for background type checking). Note that fsc.fs also
     /// creates an incremental builder used by the command line compiler.
     let CreateOneIncrementalBuilder (options:FSharpProjectOptions) = 
@@ -2200,7 +2204,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
         let builderOpt, errorsAndWarnings = 
             IncrementalFSharpBuild.IncrementalBuilder.TryCreateBackgroundBuilderForProjectOptions
-                  (scriptClosureCache.TryGet options, Array.toList options.ProjectFileNames, 
+                  (frameworkTcImportsCache, scriptClosureCache.TryGet options, Array.toList options.ProjectFileNames, 
                    Array.toList options.OtherOptions, projectReferences, options.ProjectDirectory, 
                    options.UseScriptResolutionRules, options.IsIncompleteTypeCheckEnvironment, keepAssemblyContents, keepAllBackgroundResolutions)
 
@@ -2468,7 +2472,7 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
                     // including by SetAlternate.
                     let builderB, errorsB, decrementB = CreateOneIncrementalBuilder options
                     incrementalBuildersCache.Set(options, (builderB, errorsB, decrementB))
-        bc.StartBackgroundCompile(options)
+        //bc.StartBackgroundCompile(options)
 
     member bc.NotifyProjectCleaned(options : FSharpProjectOptions) =
         match incrementalBuildersCache.TryGetAny options with
@@ -2482,9 +2486,6 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
             ()
 #endif
 
-    member bc.InvalidateAll() =
-        reactor.EnqueueOp (fun () -> incrementalBuildersCache.Clear())
-
     member bc.StartBackgroundCompile(options) =
         reactor.StartBackgroundOp(fun () -> 
             let builderOpt,_,_ = getOrCreateBuilder options
@@ -2506,6 +2507,18 @@ type BackgroundCompiler(projectCacheSize, keepAssemblyContents, keepAllBackgroun
 
     member bc.CurrentQueueLength = reactor.CurrentQueueLength
 
+    member bc.ClearCaches() =
+        reactor.EnqueueOp (fun () -> 
+            incrementalBuildersCache.Clear()
+            frameworkTcImportsCache.Clear()
+            scriptClosureCache.Clear())
+
+    member bc.DownsizeCaches() =
+        reactor.EnqueueOp (fun () -> 
+            incrementalBuildersCache.Resize(keepStrongly=1, keepMax=1)
+            frameworkTcImportsCache.Downsize()
+            scriptClosureCache.Resize(keepStrongly=1, keepMax=1))
+         
 
 #if SILVERLIGHT
 #else
@@ -2937,6 +2950,11 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
              areSame=AreSameForChecking3,
              areSameForSubsumption=AreSubsumable3)
 
+    let mutable downsizedCaches = false
+    let mutable maxMB = maxMBDefault
+    let maxMemEvent = new Event<unit>()
+
+
     static member Create() = 
         new FSharpChecker(projectCacheSizeDefault,false,true)
 
@@ -2959,6 +2977,7 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
 
     member ic.ParseFileInProject(filename, source, options) =
         async { 
+            ic.CheckDownsizeCaches()
             match parseFileInProjectCache.TryGet (filename, source, options) with 
             | Some res -> return res
             | None -> 
@@ -2983,23 +3002,36 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
     /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation.
     /// For example, the type provider approvals file may have changed.
     member ic.InvalidateAll() =
-        backgroundCompiler.InvalidateAll()
+        ic.ClearCaches()
 
+    member ic.ClearCaches() =
+        parseAndCheckFileInProjectCachePossiblyStale.Clear()
+        parseAndCheckFileInProjectCache.Clear()
+        braceMatchCache.Clear()
+        parseFileInProjectCache.Clear()
+        backgroundCompiler.ClearCaches()
+
+    member ic.CheckDownsizeCaches() =
+      if not downsizedCaches && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then 
+        // If the maxMB limit is reached, drastic action is taken
+        //   - reduce strong cache sizes to a minimum
+        downsizedCaches <- true
+        parseAndCheckFileInProjectCachePossiblyStale.Resize(keepStrongly=1)
+        parseAndCheckFileInProjectCache.Resize(keepStrongly=1)
+        braceMatchCache.Resize(keepStrongly=1)
+        parseFileInProjectCache.Resize(keepStrongly=1)
+        backgroundCompiler.DownsizeCaches()
+        maxMemEvent.Trigger( () )
+
     /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation.
     /// For example, the type provider approvals file may have changed.
     //
     // This is for unit testing only
     member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() =
-        ic.InvalidateAll()
-        parseAndCheckFileInProjectCachePossiblyStale.Clear()
-        parseAndCheckFileInProjectCache.Clear()
-        braceMatchCache.Clear()
-        parseFileInProjectCache.Clear()
-        IncrementalFSharpBuild.ClearFrameworkTcImportsCache()
-        for i in 0 .. 2 do 
-            System.GC.Collect()
-            System.GC.WaitForPendingFinalizers() 
-            backgroundCompiler.WaitForBackgroundCompile() // flush AsyncOp
+        ic.ClearCaches()
+        System.GC.Collect()
+        System.GC.WaitForPendingFinalizers() 
+        backgroundCompiler.WaitForBackgroundCompile() // flush AsyncOp
 
     /// This function is called when the configuration is known to have changed for reasons not encoded in the ProjectOptions.
     /// For example, dependent references may have been deleted or created.
@@ -3014,7 +3046,8 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
         match checkAnswer with 
         | None
         | Some FSharpCheckFileAnswer.Aborted -> 
-            backgroundCompiler.StartBackgroundCompile(options) 
+            //backgroundCompiler.StartBackgroundCompile(options) 
+            ()
         | Some (FSharpCheckFileAnswer.Succeeded typedResults) -> 
             foregroundTypeCheckCount <- foregroundTypeCheckCount + 1
             parseAndCheckFileInProjectCachePossiblyStale.Set((filename,options),(parseResults,typedResults,fileVersion))            
@@ -3035,6 +3068,7 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
     member ic.CheckFileInProject(parseResults:FSharpParseFileResults, filename:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?isResultObsolete, ?textSnapshotInfo:obj) =        
         let (IsResultObsolete(isResultObsolete)) = defaultArg isResultObsolete (IsResultObsolete(fun _ -> false))
         async {
+            ic.CheckDownsizeCaches()
             let! checkAnswer = backgroundCompiler.CheckFileInProject(parseResults,filename,source,options,isResultObsolete,textSnapshotInfo)
             ic.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,Some checkAnswer,source)
             return checkAnswer 
@@ -3046,13 +3080,15 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
         let cachedResults = parseAndCheckFileInProjectCache.TryGet((filename,source,options)) 
         let (IsResultObsolete(isResultObsolete)) = defaultArg isResultObsolete (IsResultObsolete(fun _ -> false))
         async {
+            ic.CheckDownsizeCaches()
             let! parseResults, checkAnswer, usedCachedResults = backgroundCompiler.ParseAndCheckFileInProject(filename,source,options,isResultObsolete,textSnapshotInfo,cachedResults)
             if not usedCachedResults then 
                 ic.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,Some checkAnswer,source)
             return (parseResults, checkAnswer)
         }
 
     member ic.ParseAndCheckProject(options) =
+        ic.CheckDownsizeCaches()
         backgroundCompiler.ParseAndCheckProject(options)
 
     /// For a given script file, get the ProjectOptions implied by the #load closure
@@ -3141,6 +3177,9 @@ type FSharpChecker(projectCacheSize, keepAssemblyContents, keepAllBackgroundReso
 
     member ic.FileTypeCheckStateIsDirty  = backgroundCompiler.BeforeBackgroundFileCheck
 
+    member ic.MaxMemoryReached = maxMemEvent.Publish
+    member ic.MaxMemory with get() = maxMB and set v = maxMB <- v
+
     static member Instance = globalInstance
 
 type FsiInteractiveChecker(reactorOps: IReactorOperations, tcConfig, tcGlobals, tcImports, tcState, loadClosure) =