Merge pull request #259 from dsyme/memfix-1

Fixes to clarify feature to reduce background checker memory usage

Author: fsgit

src/fsharp/nameres.fs

@@ -1275,20 +1275,25 @@ type CapturedNameResolution(p:pos, i:Item, io:ItemOccurence, de:DisplayEnv, nre:
         sprintf "%A: %+A" (p.Line, p.Column) i
 
 /// Represents container for all name resolutions that were met so far when typechecking some particular file
-/// Has reference to the container for the previous file so at some point we can access results of all name resolution that happen before
 type TcResolutions
-    (g,
-     capturedEnvs : ResizeArray<range * NameResolutionEnv * AccessorDomain>,
+    (capturedEnvs : ResizeArray<range * NameResolutionEnv * AccessorDomain>,
      capturedExprTypes : ResizeArray<pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range>,
      capturedNameResolutions : ResizeArray<CapturedNameResolution>,
-     capturedMethodGroupResolutions : ResizeArray<CapturedNameResolution>
-    ) = 
+     capturedMethodGroupResolutions : ResizeArray<CapturedNameResolution>) = 
 
+    static let empty = TcResolutions(ResizeArray(0),ResizeArray(0),ResizeArray(0),ResizeArray(0))
+    
     member this.CapturedEnvs = capturedEnvs
     member this.CapturedExpressionTypings = capturedExprTypes
     member this.CapturedNameResolutions = capturedNameResolutions
     member this.CapturedMethodGroupResolutions = capturedMethodGroupResolutions
 
+    static member Empty = empty
+
+
+/// Represents container for all name resolutions that were met so far when typechecking some particular file
+type TcSymbolUses(g,capturedNameResolutions : ResizeArray<CapturedNameResolution>) = 
+
     member this.GetUsesOfSymbol(item) = 
         [| for cnr in capturedNameResolutions do
                if protectAssemblyExploration false (fun () -> ItemsAreEffectivelyEqual g item cnr.Item) then
@@ -1300,17 +1305,23 @@ type TcResolutions
 
 /// An accumulator for the results being emitted into the tcSink.
 type TcResultsSinkImpl(g) =
-    let capturedEnvs = new ResizeArray<_>(100)
-    let capturedExprTypings = new ResizeArray<_>(100)
-    let capturedNameResolutions = new ResizeArray<_>(100)
+    let capturedEnvs = ResizeArray<_>()
+    let capturedExprTypings = ResizeArray<_>()
+    let capturedNameResolutions = ResizeArray<_>()
     let capturedNameResolutionIdentifiers = 
         new System.Collections.Generic.Dictionary<pos * string, unit>
             ( { new IEqualityComparer<_> with 
                     member __.GetHashCode((p:pos,i)) = p.Line + 101 * p.Column + hash i
                     member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 =  i2 } )
-    let capturedMethodGroupResolutions = new ResizeArray<_>(100)
+    let capturedMethodGroupResolutions = ResizeArray<_>()
     let allowedRange (m:range) = not m.IsSynthetic       
-    member this.GetTcResolutions() = TcResolutions(g, capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions)
+
+    member this.GetResolutions() = 
+        TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions)
+
+    member this.GetSymbolUses() = 
+        TcSymbolUses(g, capturedNameResolutions)
+
     interface ITypecheckResultsSink with
         member sink.NotifyEnvWithScope(m,nenv,ad) = 
             if allowedRange m then 

src/fsharp/nameres.fsi

@@ -204,16 +204,28 @@ type internal CapturedNameResolution =
 
 [<Class>]
 type internal TcResolutions = 
+
     /// Name resolution environments for every interesting region in the file. These regions may
     /// overlap, in which case the smallest region applicable should be used.
     member CapturedEnvs : ResizeArray<range * NameResolutionEnv * AccessorDomain>
+
     /// Information of exact types found for expressions, that can be to the left of a dot.
     /// typ - the inferred type for an expression
     member CapturedExpressionTypings : ResizeArray<pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range>
+
     /// Exact name resolutions
     member CapturedNameResolutions : ResizeArray<CapturedNameResolution>
+
     member CapturedMethodGroupResolutions : ResizeArray<CapturedNameResolution>
+
+    static member Empty : TcResolutions
+
+
+[<Class>]
+type internal TcSymbolUses = 
+
     member GetUsesOfSymbol : Item -> (ItemOccurence * DisplayEnv * range)[]
+
     member GetAllUsesOfSymbols : unit -> (Item * ItemOccurence * DisplayEnv * range)[]
 
 /// An abstract type for reporting the results of name resolution and type checking
@@ -224,7 +236,8 @@ type ITypecheckResultsSink =
 
 type internal TcResultsSinkImpl =
     new : tcGlobals : TcGlobals -> TcResultsSinkImpl
-    member GetTcResolutions : unit -> TcResolutions
+    member GetResolutions : unit -> TcResolutions
+    member GetSymbolUses : unit -> TcSymbolUses
     interface ITypecheckResultsSink
 
 /// An abstract type for reporting the results of name resolution and type checking, and which allows

src/fsharp/vs/IncrementalBuild.fs

@@ -1066,6 +1066,7 @@ module internal IncrementalFSharpBuild =
           tcConfig:TcConfig
           tcEnvAtEndOfFile: TcEnv
           tcResolutions: Nameres.TcResolutions list
+          tcSymbolUses: Nameres.TcSymbolUses list
           topAttribs:TopAttribs option
           typedImplFiles:TypedImplFile list
           tcErrors:(PhasedError * FSharpErrorSeverity) list } // errors=true, warnings=false
@@ -1168,6 +1169,7 @@ module internal IncrementalFSharpBuild =
         TcEnvAtEnd : TypeChecker.TcEnv 
         Errors : (PhasedError * FSharpErrorSeverity) list 
         TcResolutions: Nameres.TcResolutions list 
+        TcSymbolUses: Nameres.TcSymbolUses list 
         TimeStamp: System.DateTime }
 
     let GetPartialCheckResults (tcAcc: TypeCheckAccumulator, timestamp) = 
@@ -1178,13 +1180,14 @@ module internal IncrementalFSharpBuild =
         TcEnvAtEnd = tcAcc.tcEnvAtEndOfFile
         Errors = tcAcc.tcErrors
         TcResolutions = tcAcc.tcResolutions
+        TcSymbolUses = tcAcc.tcSymbolUses
         TimeStamp = timestamp }
 
 
     type IncrementalBuilder(tcConfig : TcConfig, projectDirectory, outfile, assemblyName, niceNameGen : Ast.NiceNameGenerator, lexResourceManager,
-                            sourceFiles:string list, projectReferences: IProjectReference list, ensureReactive, 
-                            keepAssemblyContents:bool)
-               =
+                            sourceFiles, projectReferences: IProjectReference list, ensureReactive, 
+                            keepAssemblyContents, keepAllBackgroundResolutions) =
+
         let tcConfigP = TcConfigProvider.Constant(tcConfig)
         let importsInvalidated = new Event<string>()
         let fileParsed = new Event<_>()
@@ -1354,6 +1357,7 @@ module internal IncrementalFSharpBuild =
                   tcConfig=tcConfig
                   tcEnvAtEndOfFile=tcEnv0
                   tcResolutions=[]
+                  tcSymbolUses=[]
                   topAttribs=None
                   typedImplFiles=[]
                   tcErrors=errorLogger.GetErrors() }   
@@ -1386,13 +1390,15 @@ module internal IncrementalFSharpBuild =
 
                         /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away
                         let typedImplFiles = if keepAssemblyContents then typedImplFiles else []
-                        let tcResolution = sink.GetTcResolutions()  
+                        let tcResolutions = if keepAllBackgroundResolutions then sink.GetResolutions() else Nameres.TcResolutions.Empty
+                        let tcSymbolUses = sink.GetSymbolUses()  
                         fileChecked.Trigger filename
                         return {tcAcc with tcState=tcState 
                                            tcEnvAtEndOfFile=tcEnvAtEndOfFile
                                            topAttribs=Some topAttribs
                                            typedImplFiles=typedImplFiles
-                                           tcResolutions=tcAcc.tcResolutions @ [tcResolution]
+                                           tcResolutions=tcAcc.tcResolutions @ [tcResolutions]
+                                           tcSymbolUses=tcAcc.tcSymbolUses @ [tcSymbolUses]
                                            tcErrors = tcAcc.tcErrors @ parseErrors @ capturingErrorLogger.GetErrors() } 
                     }
 
@@ -1709,7 +1715,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) =
+        static member TryCreateBackgroundBuilderForProjectOptions (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()
@@ -1788,7 +1794,8 @@ module internal IncrementalFSharpBuild =
                 let builder = 
                     new IncrementalBuilder(tcConfig, projectDirectory, outfile, assemblyName, niceNameGen,
                                            resourceManager, sourceFilesNew, projectReferences, ensureReactive=true, 
-                                           keepAssemblyContents=keepAssemblyContents)
+                                           keepAssemblyContents=keepAssemblyContents, 
+                                           keepAllBackgroundResolutions=keepAllBackgroundResolutions)
                 Some builder
              with e -> 
                errorRecoveryNoRange e

src/fsharp/vs/IncrementalBuild.fsi

@@ -57,6 +57,7 @@ module internal IncrementalFSharpBuild =
         TcEnvAtEnd : TypeChecker.TcEnv 
         Errors : (PhasedError * FSharpErrorSeverity) list 
         TcResolutions: Nameres.TcResolutions list 
+        TcSymbolUses: Nameres.TcSymbolUses list 
         TimeStamp: DateTime }
 
   [<Class>]
@@ -144,7 +145,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 -> IncrementalBuilder option * FSharpErrorInfo 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 
 
 [<Obsolete("This type has been renamed to FSharpErrorInfo")>]
 /// Renamed to FSharpErrorInfo