Even more Adaptive performance tweaks

.vscode/launch.json

@@ -78,7 +78,7 @@
       "args": [
         "--debug",
         "--filter",
-        "FSAC.lsp.${input:loader}.${input:testName}"
+        "FSAC.lsp.${input:loader}.${input:lsp-server}.${input:testName}"
       ]
     }
   ],
@@ -103,6 +103,17 @@
       "default": "WorkspaceLoader",
       "type": "pickString"
     },
+
+    {
+      "id": "lsp-server",
+      "description": "The lsp serrver",
+      "options": [
+        "FSharpLspServer",
+        "AdaptiveLspServer"
+      ],
+      "default": "FSharpLspServer",
+      "type": "pickString"
+    },
     {
       "id": "testName",
       "description": "the name of the test as provided to `testCase`",

paket.dependencies

@@ -50,6 +50,7 @@ nuget YoloDev.Expecto.TestSdk
 nuget AltCover
 nuget GitHubActionsTestLogger
 nuget Ionide.LanguageServerProtocol
+nuget Microsoft.Extensions.Caching.Memory
 
 group Build
   source https://api.nuget.org/v3/index.json

paket.lock

@@ -176,12 +176,33 @@ NUGET
       System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (&& (== net7.0) (< net6.0)) (== netstandard2.0)
     Microsoft.CodeCoverage (17.3) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net45)) (&& (== netstandard2.0) (>= netcoreapp1.0))
     Microsoft.DotNet.PlatformAbstractions (3.1.6) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net5.0))
+    Microsoft.Extensions.Caching.Abstractions (6.0)
+      Microsoft.Extensions.Primitives (>= 6.0)
+    Microsoft.Extensions.Caching.Memory (6.0.1)
+      Microsoft.Extensions.Caching.Abstractions (>= 6.0)
+      Microsoft.Extensions.DependencyInjection.Abstractions (>= 6.0)
+      Microsoft.Extensions.Logging.Abstractions (>= 6.0)
+      Microsoft.Extensions.Options (>= 6.0)
+      Microsoft.Extensions.Primitives (>= 6.0)
+    Microsoft.Extensions.DependencyInjection.Abstractions (6.0)
+      Microsoft.Bcl.AsyncInterfaces (>= 6.0) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0)
+      System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0)
     Microsoft.Extensions.DependencyModel (6.0) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net5.0))
       System.Buffers (>= 4.5.1)
       System.Memory (>= 4.5.4)
       System.Runtime.CompilerServices.Unsafe (>= 6.0)
       System.Text.Encodings.Web (>= 6.0)
       System.Text.Json (>= 6.0)
+    Microsoft.Extensions.Logging.Abstractions (6.0.2)
+      System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< net6.0)) (== netstandard2.0)
+      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< net6.0)) (== netstandard2.0)
+    Microsoft.Extensions.Options (6.0)
+      Microsoft.Extensions.DependencyInjection.Abstractions (>= 6.0)
+      Microsoft.Extensions.Primitives (>= 6.0)
+      System.ComponentModel.Annotations (>= 5.0) - restriction: || (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0)
+    Microsoft.Extensions.Primitives (6.0)
+      System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netcoreapp3.1)) (== netstandard2.0)
+      System.Runtime.CompilerServices.Unsafe (>= 6.0)
     Microsoft.NET.StringTools (17.3.1) - copy_local: false
       System.Memory (>= 4.5.5)
       System.Runtime.CompilerServices.Unsafe (>= 6.0)
@@ -319,6 +340,7 @@ NUGET
       System.Runtime.CompilerServices.Unsafe (>= 6.0)
     System.CommandLine (2.0.0-beta4.22272.1)
       System.Memory (>= 4.5.4) - restriction: || (&& (== net7.0) (< net6.0)) (== netstandard2.0)
+    System.ComponentModel.Annotations (5.0) - restriction: || (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0)
     System.Configuration.ConfigurationManager (6.0)
       System.Security.Cryptography.ProtectedData (>= 6.0)
       System.Security.Permissions (>= 6.0)

src/FsAutoComplete.Core/CodeGeneration.fs

@@ -1,4 +1,4 @@
-/// Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/CodeGeneration/CodeGeneration.fs
+// Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/CodeGeneration/CodeGeneration.fs
 namespace FsAutoComplete
 
 open System

src/FsAutoComplete.Core/Commands.fs

@@ -713,11 +713,9 @@ module Commands =
 
       let getSymbolUsesInProjects (symbol, projects: FSharpProjectOptions list, onFound) =
         projects
-        |> List.map (fun p ->
-          asyncResult {
-            for file in p.SourceFiles do
-              do! findReferencesInFile (file, symbol, p, onFound)
-          })
+        |> List.collect (fun p ->
+          [ for file in p.SourceFiles do
+              yield findReferencesInFile (file, symbol, p, onFound) ])
         |> Async.Parallel
         |> Async.map (Array.toList >> FsToolkit.ErrorHandling.List.sequenceResultM)
 
@@ -770,9 +768,9 @@ module Commands =
         let symbolRange = symbol.DefinitionRange.NormalizeDriveLetterCasing()
         let symbolFile = symbolRange.TaggedFileName
 
-        let symbolFileText =
+        let! symbolFileText =
           tryGetFileSource (symbolFile)
-          |> Result.fold id (fun e -> failwith $"Unable to get file source for file '{symbolFile}'")
+          |> Result.mapError (fun e -> e + $"Unable to get file source for file '{symbolFile}'")
 
         let! symbolText = symbolFileText.[symbolRange]
         // |> Result.fold id (fun e -> failwith "Unable to get text for initial symbol use")
@@ -790,37 +788,40 @@ module Commands =
             |> List.distinctBy (fun x -> x.ProjectFileName)
 
         let onFound (symbolUseRange: range) =
-          async {
+          asyncResult {
             let symbolUseRange = symbolUseRange.NormalizeDriveLetterCasing()
             let symbolFile = symbolUseRange.TaggedFileName
-            let targetText = tryGetFileSource (symbolFile)
-
-            match targetText with
-            | Error e -> ()
-            | Ok sourceText ->
-              let sourceSpan =
-                sourceText.[symbolUseRange]
-                |> Result.fold id (fun e -> failwith "Unable to get text for symbol use")
-
-              // There are two kinds of ranges we get back:
-              // * ranges that exactly match the short name of the symbol
-              // * ranges that are longer than the short name of the symbol,
-              //   typically because we're talking about some kind of fully-qualified usage
-              // For the latter, we need to adjust the reported range to just be the portion
-              // of the fully-qualfied text that is the symbol name.
-              if sourceSpan = symbolText then
-                symbolUseRanges.Add symbolUseRange
-              else
-                match sourceSpan.IndexOf(symbolText) with
-                | -1 -> ()
-                | n ->
-                  if sourceSpan.Length >= n + symbolText.Length then
-                    let startPos = symbolUseRange.Start.IncColumn n
-                    let endPos = symbolUseRange.Start.IncColumn(n + symbolText.Length)
-
-                    let actualUseRange = Range.mkRange symbolUseRange.FileName startPos endPos
-                    symbolUseRanges.Add actualUseRange
+            let! sourceText = tryGetFileSource (symbolFile)
+
+
+            let! sourceSpan =
+              sourceText.[symbolUseRange]
+              |> Result.mapError (fun e -> e + "Unable to get text for symbol use")
+
+            // There are two kinds of ranges we get back:
+            // * ranges that exactly match the short name of the symbol
+            // * ranges that are longer than the short name of the symbol,
+            //   typically because we're talking about some kind of fully-qualified usage
+            // For the latter, we need to adjust the reported range to just be the portion
+            // of the fully-qualfied text that is the symbol name.
+            if sourceSpan = symbolText then
+              symbolUseRanges.Add symbolUseRange
+            else
+              match sourceSpan.IndexOf(symbolText) with
+              | -1 -> ()
+              | n ->
+                if sourceSpan.Length >= n + symbolText.Length then
+                  let startPos = symbolUseRange.Start.IncColumn n
+                  let endPos = symbolUseRange.Start.IncColumn(n + symbolText.Length)
+
+                  let actualUseRange = Range.mkRange symbolUseRange.FileName startPos endPos
+                  symbolUseRanges.Add actualUseRange
           }
+          |> Async.map (fun x ->
+            match x with
+            | Ok () -> ()
+            | Error e ->
+              commandsLogger.info (Log.setMessage "OnFound failed: {errpr}" >> Log.addContextDestructured "error" e))
 
         let! _ = getSymbolUsesInProjects (symbol, projects, onFound)
 

src/FsAutoComplete.Core/CompilerServiceInterface.fs

@@ -9,6 +9,11 @@ open Ionide.ProjInfo.ProjectSystem
 open FSharp.UMX
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Symbols
+open Microsoft.Extensions.Caching.Memory
+open System
+open FsToolkit.ErrorHandling
+
+
 
 type Version = int
 
@@ -26,6 +31,9 @@ type FSharpCompilerServiceChecker(hasAnalyzers) =
 
   let entityCache = EntityCache()
 
+  let mutable lastCheckResults: IMemoryCache =
+    new MemoryCache(MemoryCacheOptions(SizeLimit = Nullable<_>(200L)))
+
   let checkerLogger = LogProvider.getLoggerByName "Checker"
   let optsLogger = LogProvider.getLoggerByName "Opts"
 
@@ -227,14 +235,22 @@ type FSharpCompilerServiceChecker(hasAnalyzers) =
   member __.ScriptTypecheckRequirementsChanged =
     scriptTypecheckRequirementsChanged.Publish
 
+  /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation.
+  member _.ClearCaches() =
+    let oldlastCheckResults = lastCheckResults
+    lastCheckResults <- new MemoryCache(MemoryCacheOptions(SizeLimit = Nullable<_>(20L)))
+    oldlastCheckResults.Dispose()
+    checker.InvalidateAll()
+    checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients()
+
   member __.ParseFile(fn: string<LocalPath>, source, fpo) =
     checkerLogger.info (Log.setMessage "ParseFile - {file}" >> Log.addContextDestructured "file" fn)
 
     let path = UMX.untag fn
     checker.ParseFile(path, source, fpo)
 
   member __.ParseAndCheckFileInProject(filePath: string<LocalPath>, version, source: ISourceText, options) =
-    async {
+    asyncResult {
       let opName = sprintf "ParseAndCheckFileInProject - %A" filePath
 
       checkerLogger.info (Log.setMessage "{opName}" >> Log.addContextDestructured "opName" opName)
@@ -255,32 +271,56 @@ type FSharpCompilerServiceChecker(hasAnalyzers) =
             >> Log.addContextDestructured "errors" (List.ofArray p.Diagnostics)
           )
 
-          return ResultOrString.Error(sprintf "Check aborted (%A). Errors: %A" c parseErrors)
+          return! ResultOrString.Error(sprintf "Check aborted (%A). Errors: %A" c parseErrors)
         | FSharpCheckFileAnswer.Succeeded (c) ->
           checkerLogger.info (
             Log.setMessage "{opName} completed successfully"
             >> Log.addContextDestructured "opName" opName
           )
 
-          return Ok(ParseAndCheckResults(p, c, entityCache))
+          let r = ParseAndCheckResults(p, c, entityCache)
+
+          let ops =
+            MemoryCacheEntryOptions()
+              .SetSize(1)
+              .SetSlidingExpiration(TimeSpan.FromMinutes(2.))
+
+          return lastCheckResults.Set(filePath, r, ops)
       with ex ->
-        return ResultOrString.Error(ex.ToString())
+        return! ResultOrString.Error(ex.ToString())
     }
 
+  member _.TryGetLastCheckResultForFile(file: string<LocalPath>) =
+    let opName = sprintf "TryGetLastCheckResultForFile - %A" file
+
+    checkerLogger.info (Log.setMessage "{opName}" >> Log.addContextDestructured "opName" opName)
+
+    match lastCheckResults.TryGetValue<ParseAndCheckResults>(file) with
+    | (true, v) -> Some v
+    | _ -> None
+
   member __.TryGetRecentCheckResultsForFile(file: string<LocalPath>, options, source: ISourceText) =
     let opName = sprintf "TryGetRecentCheckResultsForFile - %A" file
 
     checkerLogger.info (
       Log.setMessage "{opName} - {hash}"
       >> Log.addContextDestructured "opName" opName
       >> Log.addContextDestructured "hash" (source.GetHashCode() |> int)
+
     )
 
     let options = clearProjectReferences options
 
     let result =
       checker.TryGetRecentCheckResultsForFile(UMX.untag file, options, sourceText = source, userOpName = opName)
-      |> Option.map (fun (pr, cr, _) -> ParseAndCheckResults(pr, cr, entityCache))
+      |> Option.map (fun (pr, cr, version) ->
+        checkerLogger.info (
+          Log.setMessage "{opName} - got results - {version}"
+          >> Log.addContextDestructured "opName" opName
+          >> Log.addContextDestructured "version" version
+        )
+
+        ParseAndCheckResults(pr, cr, entityCache))
 
     checkerLogger.info (
       Log.setMessage "{opName} - {hash} - cacheHit {cacheHit}"

src/FsAutoComplete.Core/FileSystem.fs

@@ -144,7 +144,7 @@ type NamedText(fileName: string<LocalPath>, str: string) =
       // because we know there are lines after the first line
       let firstLine = (x :> ISourceText).GetLineString(m.StartLine - 1)
 
-      builder.AppendLine(firstLine.Substring(m.StartColumn))
+      builder.AppendLine(firstLine.Substring(Math.Min(firstLine.Length, m.StartColumn)))
       |> ignore<System.Text.StringBuilder>
 
       // whole intermediate lines, including newlines
@@ -155,7 +155,7 @@ type NamedText(fileName: string<LocalPath>, str: string) =
       // final part, potential slice, so we do not include the trailing newline
       let lastLine = (x :> ISourceText).GetLineString(m.EndLine - 1)
 
-      builder.Append(lastLine.Substring(0, m.EndColumn))
+      builder.Append(lastLine.Substring(0, Math.Min(lastLine.Length, m.EndColumn)))
       |> ignore<System.Text.StringBuilder>
 
       Ok(builder.ToString())
@@ -260,8 +260,8 @@ type NamedText(fileName: string<LocalPath>, str: string) =
   member x.ModifyText(m: FSharp.Compiler.Text.Range, text: string) : Result<NamedText, string> =
     result {
       let startRange, endRange = x.SplitAt(m)
-      let! startText = x[startRange]
-      let! endText = x[endRange]
+      let! startText = x[startRange] |> Result.mapError (fun x -> $"startRange -> {x}")
+      and! endText = x[endRange] |> Result.mapError (fun x -> $"endRange -> {x}")
       let totalText = startText + text + endText
       return NamedText(x.FileName, totalText)
     }
@@ -355,6 +355,8 @@ type VolatileFile =
     Lines: NamedText
     Version: int option }
 
+  member this.FileName = this.Lines.FileName
+
   /// <summary>Updates the Lines value</summary>
   member this.SetLines(lines) = { this with Lines = lines }
 
@@ -407,11 +409,18 @@ type FileSystem(actualFs: IFileSystem, tryFindFile: string<LocalPath> -> Volatil
   let fsLogger = LogProvider.getLoggerByName "FileSystem"
 
   let getContent (filename: string<LocalPath>) =
-    fsLogger.debug (Log.setMessage "Getting content of `{path}`" >> Log.addContext "path" filename)
+
 
     filename
     |> tryFindFile
-    |> Option.map (fun file -> file.Lines.ToString() |> System.Text.Encoding.UTF8.GetBytes)
+    |> Option.map (fun file ->
+        fsLogger.debug (
+          Log.setMessage "Getting content of `{path}` - {hash}"
+          >> Log.addContext "path" filename
+          >> Log.addContext "hash" (file.Lines.GetHashCode())
+        )
+        file.Lines.ToString() |> System.Text.Encoding.UTF8.GetBytes
+      )
 
   /// translation of the BCL's Windows logic for Path.IsPathRooted.
   ///
@@ -455,12 +464,18 @@ type FileSystem(actualFs: IFileSystem, tryFindFile: string<LocalPath> -> Volatil
 
       expanded
 
-    member _.GetLastWriteTimeShim(f: string) =
-      f
-      |> Utils.normalizePath
-      |> tryFindFile
-      |> Option.map (fun f -> f.Touched)
-      |> Option.defaultWith (fun () -> actualFs.GetLastWriteTimeShim f)
+    member _.GetLastWriteTimeShim(filename: string) =
+      let result =
+        filename
+        |> Utils.normalizePath
+        |> tryFindFile
+        |> Option.map (fun f -> f.Touched)
+        |> Option.defaultWith (fun () -> actualFs.GetLastWriteTimeShim filename)
+
+      fsLogger.debug (Log.setMessage "GetLastWriteTimeShim of `{path}` - {date} "
+      >> Log.addContext "path" filename
+      >> Log.addContext "date" result)
+      result
 
     member _.NormalizePathShim(f: string) = f |> Utils.normalizePath |> UMX.untag
 

src/FsAutoComplete.Core/Lexer.fs

@@ -247,7 +247,7 @@ module Lexer =
         | StaticallyResolvedTypeParameter
         | Keyword -> true
         | _ -> false)
-      /// Gets the option if Some x, otherwise try to get another value
+      // Gets the option if Some x, otherwise try to get another value
 
       |> Option.orElseWith (fun _ -> tokensUnderCursor |> List.tryFind (fun { DraftToken.Kind = k } -> k = Operator))
       |> Option.map (fun token ->