Reduce resident memory for VS tokenization and other caches (#4590)

* improve tokenizer memory performance

* add comments

* use Memory Cache with sliding window for tokeniztion information

* use MemoryCache

Author: dsyme

src/fsharp/service/ServiceDeclarationLists.fs

@@ -736,7 +736,7 @@ type FSharpMethodGroup( name: string, unsortedMethods: FSharpMethodGroupItem[] )
     // BUG 413009 : [ParameterInfo] takes about 3 seconds to move from one overload parameter to another
     // cache allows to avoid recomputing parameterinfo for the same item
 #if !FX_NO_WEAKTABLE
-    static let methodOverloadsCache = System.Runtime.CompilerServices.ConditionalWeakTable()
+    static let methodOverloadsCache = System.Runtime.CompilerServices.ConditionalWeakTable<ItemWithInst, FSharpMethodGroupItem[]>()
 #endif
 
     let methods = 

src/fsharp/service/ServiceLexing.fs

@@ -77,6 +77,9 @@ module FSharpTokenTag =
     let STRUCT = tagOfToken STRUCT
     let CLASS = tagOfToken CLASS
     let TRY = tagOfToken TRY
+    let NEW = tagOfToken NEW
+    let WITH = tagOfToken WITH
+    let OWITH = tagOfToken OWITH
 
 
 /// This corresponds to a token categorization originally used in Visual Studio 2003.

src/fsharp/service/ServiceLexing.fsi

@@ -182,6 +182,12 @@ module FSharpTokenTag =
     val CLASS : int
     /// Indicates the token is keyword `try`
     val TRY : int
+    /// Indicates the token is keyword `with`
+    val WITH : int
+    /// Indicates the token is keyword `with` in #light
+    val OWITH : int
+    /// Indicates the token is keyword `new` 
+    val NEW : int
 
 /// Information about a particular token from the tokenizer
 type FSharpTokenInfo = 

vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs

@@ -22,7 +22,7 @@ type internal InterfaceState =
     { InterfaceData: InterfaceData 
       EndPosOfWith: pos option
       AppendBracketAt: int option
-      Tokens: FSharpTokenInfo list }
+      Tokens: Tokenizer.SavedTokenInfo[] }
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = "ImplementInterface"); Shared>]
 type internal FSharpImplementInterfaceCodeFixProvider
@@ -36,15 +36,15 @@ type internal FSharpImplementInterfaceCodeFixProvider
     let checker = checkerProvider.Checker
     static let userOpName = "ImplementInterfaceCodeFixProvider"
 
-    let queryInterfaceState appendBracketAt (pos: pos) tokens (ast: Ast.ParsedInput) =
+    let queryInterfaceState appendBracketAt (pos: pos) (tokens: Tokenizer.SavedTokenInfo[]) (ast: Ast.ParsedInput) =
         asyncMaybe {
             let line = pos.Line - 1
             let column = pos.Column
             let! iface = InterfaceStubGenerator.tryFindInterfaceDeclaration pos ast
             let endPosOfWidth =
                 tokens 
-                |> List.tryPick (fun (t: FSharpTokenInfo) ->
-                        if t.CharClass = FSharpTokenCharKind.Keyword && t.LeftColumn >= column && t.TokenName = "WITH" then
+                |> Array.tryPick (fun (t: Tokenizer.SavedTokenInfo) ->
+                        if t.Tag = FSharpTokenTag.WITH || t.Tag = FSharpTokenTag.OWITH then
                             Some (Pos.fromZ line (t.RightColumn + 1))
                         else None)
             let appendBracketAt =
@@ -70,8 +70,8 @@ type internal FSharpImplementInterfaceCodeFixProvider
                 getLineIdent lineStr + indentSize
             | InterfaceData.ObjExpr _ as iface ->
                 state.Tokens 
-                |> List.tryPick (fun (t: FSharpTokenInfo) ->
-                            if t.CharClass = FSharpTokenCharKind.Keyword && t.TokenName = "NEW" then
+                |> Array.tryPick (fun (t: Tokenizer.SavedTokenInfo) ->
+                            if t.Tag = FSharpTokenTag.NEW then
                                 Some (t.LeftColumn + indentSize)
                             else None)
                 // There is no reference point, we indent the content at the start column of the interface
@@ -149,18 +149,18 @@ type internal FSharpImplementInterfaceCodeFixProvider
             // That's why we tokenize the line and try to find the last successive identifier token
             let tokens = Tokenizer.tokenizeLine(context.Document.Id, sourceText, context.Span.Start, context.Document.FilePath, defines)
             let startLeftColumn = context.Span.Start - textLine.Start
-            let rec tryFindIdentifierToken acc tokens =
-               match tokens with
-               | t :: remainingTokens when t.LeftColumn < startLeftColumn ->
+            let rec tryFindIdentifierToken acc i =
+               if i >= tokens.Length then acc else
+               match tokens.[i] with
+               | t when t.LeftColumn < startLeftColumn ->
                    // Skip all the tokens starting before the context
-                   tryFindIdentifierToken acc remainingTokens
-               | t :: remainingTokens when t.Tag = FSharpTokenTag.Identifier ->
-                   tryFindIdentifierToken (Some t) remainingTokens
-               | t :: remainingTokens when t.Tag = FSharpTokenTag.DOT || Option.isNone acc ->
-                   tryFindIdentifierToken acc remainingTokens
-               | _ :: _ 
-               | [] -> acc
-            let! token = tryFindIdentifierToken None tokens
+                   tryFindIdentifierToken acc (i+1)
+               | t when t.Tag = FSharpTokenTag.Identifier ->
+                   tryFindIdentifierToken (Some t) (i+1)
+               | t when t.Tag = FSharpTokenTag.DOT || Option.isNone acc ->
+                   tryFindIdentifierToken acc (i+1)
+               | _ -> acc
+            let! token = tryFindIdentifierToken None 0
             let fixupPosition = textLine.Start + token.RightColumn
             let interfacePos = Pos.fromZ textLine.LineNumber token.RightColumn
             // We rely on the observation that the lastChar of the context should be '}' if that character is present

vsintegration/src/FSharp.Editor/Common/Extensions.fs

@@ -147,27 +147,22 @@ module Option =
         else
             None
 
+[<RequireQualifiedAccess>]
+module Seq =
+    open System.Collections.Immutable
+
+    let toImmutableArray (xs: seq<'a>) : ImmutableArray<'a> = xs.ToImmutableArray()
 
 [<RequireQualifiedAccess>]
-module List =
-    let foldi (folder : 'State -> int -> 'T -> 'State) (state : 'State) (xs : 'T list) =
+module Array =
+    let foldi (folder : 'State -> int -> 'T -> 'State) (state : 'State) (xs : 'T[]) =
         let mutable state = state
         let mutable i = 0
         for x in xs do
             state <- folder state i x
             i <- i + 1
         state
 
-
-[<RequireQualifiedAccess>]
-module Seq =
-    open System.Collections.Immutable
-
-    let toImmutableArray (xs: seq<'a>) : ImmutableArray<'a> = xs.ToImmutableArray()
-
-
-[<RequireQualifiedAccess>]
-module Array =
     /// Optimized arrays equality. ~100x faster than `array1 = array2` on strings.
     /// ~2x faster for floats
     /// ~0.8x slower for ints
@@ -178,12 +173,12 @@ module Array =
         | null, _ | _, null -> false
         | _ when xs.Length <> ys.Length -> false
         | _ ->
-            let mutable break' = false
+            let mutable stop = false
             let mutable i = 0
             let mutable result = true
-            while i < xs.Length && not break' do
+            while i < xs.Length && not stop do
                 if xs.[i] <> ys.[i] then 
-                    break' <- true
+                    stop <- true
                     result <- false
                 i <- i + 1
             result

vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs

@@ -20,6 +20,7 @@ open Microsoft.VisualStudio.Shell.Interop
 open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.SourceCodeServices
+open System.Runtime.Caching
 
 type internal FSharpCompletionProvider
     (
@@ -33,7 +34,8 @@ type internal FSharpCompletionProvider
     inherit CompletionProvider()
 
     static let userOpName = "CompletionProvider"
-    static let declarationItemsCache = ConditionalWeakTable<string, FSharpDeclarationListItem>()
+    // Save the backing data in a memory cache held in a sliding window
+    static let declarationItemsCache = new MemoryCache("FSharp.Editor." + userOpName)
     static let [<Literal>] NameInCodePropName = "NameInCode"
     static let [<Literal>] FullNamePropName = "FullName"
     static let [<Literal>] IsExtensionMemberPropName = "IsExtensionMember"
@@ -138,15 +140,15 @@ type internal FSharpCompletionProvider
 
             let maxHints = if mruItems.Values.Count = 0 then 0 else Seq.max mruItems.Values
 
-            sortedDeclItems |> Array.iteri (fun number declItem ->
-                let glyph = Tokenizer.FSharpGlyphToRoslynGlyph (declItem.Glyph, declItem.Accessibility)
+            sortedDeclItems |> Array.iteri (fun number declarationItem ->
+                let glyph = Tokenizer.FSharpGlyphToRoslynGlyph (declarationItem.Glyph, declarationItem.Accessibility)
                 let name =
-                    match declItem.NamespaceToOpen with
-                    | Some namespaceToOpen -> sprintf "%s (open %s)" declItem.Name namespaceToOpen
-                    | _ -> declItem.Name
+                    match declarationItem.NamespaceToOpen with
+                    | Some namespaceToOpen -> sprintf "%s (open %s)" declarationItem.Name namespaceToOpen
+                    | _ -> declarationItem.Name
 
                 let filterText =
-                    match declItem.NamespaceToOpen, declItem.Name.Split '.' with
+                    match declarationItem.NamespaceToOpen, declarationItem.Name.Split '.' with
                     // There is no namespace to open and the item name does not contain dots, so we don't need to pass special FilterText to Roslyn.
                     | None, [|_|] -> null
                     // Either we have a namespace to open ("DateTime (open System)") or item name contains dots ("Array.map"), or both.
@@ -155,39 +157,37 @@ type internal FSharpCompletionProvider
 
                 let completionItem = 
                     CommonCompletionItem.Create(name, glyph = Nullable glyph, rules = getRules(), filterText = filterText)
-                                        .AddProperty(FullNamePropName, declItem.FullName)
+                                        .AddProperty(FullNamePropName, declarationItem.FullName)
 
                 let completionItem =
-                    match declItem.Kind with
+                    match declarationItem.Kind with
                     | CompletionItemKind.Method (isExtension = true) ->
                           completionItem.AddProperty(IsExtensionMemberPropName, "")
                     | _ -> completionItem
 
                 let completionItem =
-                    if name <> declItem.NameInCode then
-                        completionItem.AddProperty(NameInCodePropName, declItem.NameInCode)
+                    if name <> declarationItem.NameInCode then
+                        completionItem.AddProperty(NameInCodePropName, declarationItem.NameInCode)
                     else completionItem
 
                 let completionItem =
-                    match declItem.NamespaceToOpen with
+                    match declarationItem.NamespaceToOpen with
                     | Some ns -> completionItem.AddProperty(NamespaceToOpenPropName, ns)
                     | None -> completionItem
 
                 let priority = 
-                    match mruItems.TryGetValue declItem.FullName with
+                    match mruItems.TryGetValue declarationItem.FullName with
                     | true, hints -> maxHints - hints
                     | _ -> number + maxHints + 1
 
                 let sortText = sprintf "%06d" priority
 
-                //#if DEBUG
-                //Logging.Logging.logInfof "***** %s => %s" name sortText
-                //#endif
-
                 let completionItem = completionItem.WithSortText(sortText)
 
-                declarationItemsCache.Remove(completionItem.DisplayText) |> ignore // clear out stale entries if they exist
-                declarationItemsCache.Add(completionItem.DisplayText, declItem)
+                let key = completionItem.DisplayText
+                let cacheItem = CacheItem(key, declarationItem)
+                let policy = CacheItemPolicy(SlidingExpiration=DefaultTuning.PerDocumentSavedDataSlidingWindow)
+                declarationItemsCache.Set(cacheItem, policy)
                 results.Add(completionItem))
 
             if results.Count > 0 && not declarations.IsForType && not declarations.IsError && List.isEmpty partialName.QualifyingIdents then
@@ -234,15 +234,15 @@ type internal FSharpCompletionProvider
 
     override this.GetDescriptionAsync(_: Document, completionItem: Completion.CompletionItem, cancellationToken: CancellationToken): Task<CompletionDescription> =
         async {
-            let exists, declarationItem = declarationItemsCache.TryGetValue(completionItem.DisplayText)
-            if exists then
+            match declarationItemsCache.Get(completionItem.DisplayText) with
+            | :? FSharpDeclarationListItem as declarationItem -> 
                 let! description = declarationItem.StructuredDescriptionTextAsync
                 let documentation = List()
                 let collector = RoslynHelpers.CollectTaggedText documentation
                 // mix main description and xmldoc by using one collector
                 XmlDocumentation.BuildDataTipText(documentationBuilder, collector, collector, collector, collector, collector, description) 
                 return CompletionDescription.Create(documentation.ToImmutableArray())
-            else
+            | _ -> 
                 return CompletionDescription.Empty
         } |> RoslynHelpers.StartAsyncAsTask cancellationToken
 

vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs

@@ -14,8 +14,10 @@ open Microsoft.CodeAnalysis.Diagnostics
 open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.SourceCodeServices
+open System.Runtime.Caching
 
 type private TextVersionHash = int
+type private PerDocumentSavedData = { Hash: int; Diagnostics: ImmutableArray<Diagnostic> }
 
 [<DiagnosticAnalyzer(FSharpConstants.FSharpLanguageName)>]
 type internal SimplifyNameDiagnosticAnalyzer() =
@@ -25,7 +27,7 @@ type internal SimplifyNameDiagnosticAnalyzer() =
     let getProjectInfoManager (document: Document) = document.Project.Solution.Workspace.Services.GetService<FSharpCheckerWorkspaceService>().FSharpProjectOptionsManager
     let getChecker (document: Document) = document.Project.Solution.Workspace.Services.GetService<FSharpCheckerWorkspaceService>().Checker
     let getPlidLength (plid: string list) = (plid |> List.sumBy String.length) + plid.Length
-    static let cache = ConditionalWeakTable<DocumentId, TextVersionHash * ImmutableArray<Diagnostic>>()
+    static let cache = new MemoryCache("FSharp.Editor." + userOpName)
     // Make sure only one document is being analyzed at a time, to be nice
     static let guard = new SemaphoreSlim(1)
 
@@ -54,8 +56,9 @@ type internal SimplifyNameDiagnosticAnalyzer() =
             let textVersionHash = textVersion.GetHashCode()
             let! _ = guard.WaitAsync(cancellationToken) |> Async.AwaitTask |> liftAsync
             try
-                match cache.TryGetValue document.Id with
-                | true, (oldTextVersionHash, diagnostics) when oldTextVersionHash = textVersionHash -> return diagnostics
+                let key = document.Id.ToString()
+                match cache.Get(key) with
+                | :? PerDocumentSavedData as data when data.Hash = textVersionHash -> return data.Diagnostics
                 | _ ->
                     let! sourceText = document.GetTextAsync()
                     let checker = getChecker document
@@ -116,8 +119,11 @@ type internal SimplifyNameDiagnosticAnalyzer() =
                                        properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary()))
 
                     let diagnostics = result.ToImmutableArray()
-                    cache.Remove(document.Id) |> ignore
-                    cache.Add(document.Id, (textVersionHash, diagnostics))
+                    cache.Remove(key) |> ignore
+                    let data = { Hash = textVersionHash; Diagnostics=diagnostics }
+                    let cacheItem = CacheItem(key, data)
+                    let policy = CacheItemPolicy(SlidingExpiration=DefaultTuning.PerDocumentSavedDataSlidingWindow)
+                    cache.Set(cacheItem, policy)
                     return diagnostics
             finally guard.Release() |> ignore
         } 

vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs

@@ -3,6 +3,8 @@
 namespace Microsoft.VisualStudio.FSharp.Editor
 
 open System
+open System.Runtime.CompilerServices
+open System.Runtime.Caching
 open System.Text.RegularExpressions
 open Internal.Utilities.Collections
 open EnvDTE
@@ -413,6 +415,6 @@ module internal XmlDocumentation =
     let BuildMethodParamText(documentationProvider, xmlCollector, xml, paramName) =
         AppendXmlComment(documentationProvider, TextSanitizingCollector(xmlCollector), TextSanitizingCollector(xmlCollector), xml, false, true, Some paramName)
 
-    let documentationBuilderCache = System.Runtime.CompilerServices.ConditionalWeakTable<IVsXMLMemberIndexService, IDocumentationBuilder>()
+    let documentationBuilderCache = ConditionalWeakTable<IVsXMLMemberIndexService, IDocumentationBuilder>()
     let CreateDocumentationBuilder(xmlIndexService: IVsXMLMemberIndexService, dte: DTE) = 
         documentationBuilderCache.GetValue(xmlIndexService,(fun _ -> Provider(xmlIndexService, dte) :> IDocumentationBuilder))

vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj

@@ -109,6 +109,7 @@
     <Reference Include="System.ComponentModel.Composition" />
     <Reference Include="System.Drawing" />
     <Reference Include="System.Windows.Forms" />
+    <Reference Include="System.Runtime.Caching" />
     <Reference Include="System.Xaml" />
     <Reference Include="System.Xml" />
     <Reference Include="System.Xml.Linq" />

vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs

@@ -44,7 +44,7 @@ type internal FSharpEditorFormattingService
 
             let! firstMeaningfulToken = 
                 tokens
-                |> List.tryFind (fun x ->
+                |> Array.tryFind (fun x ->
                     x.Tag <> FSharpTokenTag.WHITESPACE &&
                     x.Tag <> FSharpTokenTag.COMMENT &&
                     x.Tag <> FSharpTokenTag.LINE_COMMENT)