Use RunImmediate for better debug stacks (#11788)

* Use RunImmediate for better debug stacks

* fix build

Co-authored-by: Don Syme <donsyme@fastmail.com>

Author: dsyme

src/fsharp/absil/illib.fs

@@ -8,6 +8,7 @@ open System.Collections.Concurrent
 open System.Diagnostics
 open System.IO
 open System.Threading
+open System.Threading.Tasks
 open System.Runtime.CompilerServices
 
 [<AutoOpen>]
@@ -86,6 +87,19 @@ module internal PervasiveAutoOpens =
 
     let notFound() = raise (KeyNotFoundException())
 
+    type Async with
+        static member RunImmediate (computation: Async<'T>, ?cancellationToken ) =
+            let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken
+            let ts = TaskCompletionSource<'T>()
+            let task = ts.Task
+            Async.StartWithContinuations(
+                computation,
+                (fun k -> ts.SetResult k),
+                (fun exn -> ts.SetException exn),
+                (fun _ -> ts.SetCanceled()),
+                cancellationToken)
+            task.Result
+
 [<Struct>]
 /// An efficient lazy for inline storage in a class type. Results in fewer thunks.
 type InlineDelayInit<'T when 'T : not struct> = 

src/fsharp/absil/illib.fsi

@@ -47,6 +47,10 @@ module internal PervasiveAutoOpens =
 
         member inline EndsWithOrdinal: value:string -> bool
 
+    type Async with
+        /// Runs the computation synchronously, always starting on the current thread.
+        static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T
+
     val foldOn: p:('a -> 'b) -> f:('c -> 'b -> 'd) -> z:'c -> x:'a -> 'd
 
     val notFound: unit -> 'a

src/fsharp/service/service.fs

@@ -955,31 +955,25 @@ type BackgroundCompiler(
 
     member _.ProjectChecked = projectChecked.Publish
 
-    member _.ClearCachesAsync (_userOpName) =
-        async {
-            return
-                lock gate (fun () ->
-                    parseCacheLock.AcquireLock (fun ltok -> 
-                        checkFileInProjectCache.Clear(ltok)
-                        parseFileCache.Clear(ltok))
-                    incrementalBuildersCache.Clear(AnyCallerThread)
-                    frameworkTcImportsCache.Clear()
-                    scriptClosureCache.Clear (AnyCallerThread)
-                )
-        }
+    member _.ClearCaches() =
+        lock gate (fun () ->
+            parseCacheLock.AcquireLock (fun ltok -> 
+                checkFileInProjectCache.Clear(ltok)
+                parseFileCache.Clear(ltok))
+            incrementalBuildersCache.Clear(AnyCallerThread)
+            frameworkTcImportsCache.Clear()
+            scriptClosureCache.Clear (AnyCallerThread)
+        )
 
-    member _.DownsizeCaches(_userOpName) =
-        async {
-            return
-                lock gate (fun () ->
-                    parseCacheLock.AcquireLock (fun ltok -> 
-                        checkFileInProjectCache.Resize(ltok, newKeepStrongly=1)
-                        parseFileCache.Resize(ltok, newKeepStrongly=1))
-                    incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1)
-                    frameworkTcImportsCache.Downsize()
-                    scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1)
-                )
-        }
+    member _.DownsizeCaches() =
+        lock gate (fun () ->
+            parseCacheLock.AcquireLock (fun ltok -> 
+                checkFileInProjectCache.Resize(ltok, newKeepStrongly=1)
+                parseFileCache.Resize(ltok, newKeepStrongly=1))
+            incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1)
+            frameworkTcImportsCache.Downsize()
+            scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1)
+        )
 
     member _.FrameworkImportsCache = frameworkTcImportsCache
 
@@ -1195,29 +1189,24 @@ type FSharpChecker(legacyReferenceResolver,
     member ic.InvalidateAll() =
         ic.ClearCaches()
 
-    member _.ClearCachesAsync(?userOpName: string) =
+    member ic.ClearCaches() =
         let utok = AnyCallerThread
-        let userOpName = defaultArg userOpName "Unknown"
         braceMatchCache.Clear(utok)
-        backgroundCompiler.ClearCachesAsync(userOpName) 
-
-    member ic.ClearCaches(?userOpName) =
-        ic.ClearCachesAsync(?userOpName=userOpName) |> Async.Start // this cache clearance is not synchronous, it will happen when the background op gets run
+        backgroundCompiler.ClearCaches() 
 
     member _.CheckMaxMemoryReached() =
         if not maxMemoryReached && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then 
             Trace.TraceWarning("!!!!!!!! MAX MEMORY REACHED, DOWNSIZING F# COMPILER CACHES !!!!!!!!!!!!!!!")
             // If the maxMB limit is reached, drastic action is taken
             //   - reduce strong cache sizes to a minimum
-            let userOpName = "MaxMemoryReached"
             maxMemoryReached <- true
             braceMatchCache.Resize(AnyCallerThread, newKeepStrongly=10)
-            backgroundCompiler.DownsizeCaches(userOpName) |> Async.RunSynchronously
+            backgroundCompiler.DownsizeCaches()
             maxMemEvent.Trigger( () )
 
     // This is for unit testing only
     member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() =
-        ic.ClearCachesAsync() |> Async.RunSynchronously
+        ic.ClearCaches()
         System.GC.Collect()
         System.GC.WaitForPendingFinalizers() 
         FxResolver.ClearStaticCaches()
@@ -1229,7 +1218,7 @@ type FSharpChecker(legacyReferenceResolver,
         backgroundCompiler.InvalidateConfiguration(options, userOpName)
 
     /// Clear the internal cache of the given projects.
-    member _.ClearCache(options: FSharpProjectOptions seq, ?userOpName: string) =
+    member _.ClearCache(options: seq<FSharpProjectOptions>, ?userOpName: string) =
         let userOpName = defaultArg userOpName "Unknown"
         backgroundCompiler.ClearCache(options, userOpName)
 

tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs

@@ -71,7 +71,7 @@ module BuildGraphTests =
 
         let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))
 
-        Async.RunSynchronously(work)
+        Async.RunImmediate(work)
         |> ignore
 
         Assert.shouldBe 1 computationCount
@@ -84,7 +84,7 @@ module BuildGraphTests =
 
         let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))
 
-        let result = Async.RunSynchronously(work)
+        let result = Async.RunImmediate(work)
 
         Assert.shouldNotBeEmpty result
         Assert.shouldBe requests result.Length
@@ -116,7 +116,7 @@ module BuildGraphTests =
 
         Assert.shouldBeTrue weak.IsAlive
 
-        Async.RunSynchronously(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)))
+        Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)))
         |> ignore
 
         GC.Collect(2, GCCollectionMode.Forced, true)

tests/FSharp.Test.Utilities/CompilerAssert.fs

@@ -132,7 +132,7 @@ type CompilerAssert private () =
             options
             |> Array.append defaultProjectOptions.OtherOptions
             |> Array.append [| "fsc.dll"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |]
-        let errors, _ = checker.Compile args |> Async.RunSynchronously
+        let errors, _ = checker.Compile args |> Async.RunImmediate
         errors, outputFilePath
 
     static let compileAux isExe options source f : unit =
@@ -397,7 +397,7 @@ type CompilerAssert private () =
 
         let parseResults =
             checker.ParseFile("test.fs", SourceText.ofString source, parseOptions)
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)
 
@@ -410,7 +410,7 @@ type CompilerAssert private () =
 
         let compileErrors, statusCode =
             checker.Compile([parseResults.ParseTree], "test", outputFilePath, dependencies, executable = isExe, noframework = true)
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors)
         Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode)
@@ -421,7 +421,7 @@ type CompilerAssert private () =
         let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] }
         let parseResults =
             checker.ParseFile("test.fs", SourceText.ofString source, parseOptions)
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)
 
@@ -434,15 +434,15 @@ type CompilerAssert private () =
 
         let compileErrors, statusCode, assembly =
             checker.CompileToDynamicAssembly([parseResults.ParseTree], assemblyName, dependencies, None, noframework = true)
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors)
         Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode)
         Assert.IsTrue(assembly.IsSome, "no assembly returned")
         Option.get assembly
 
     static member Pass (source: string) =
-        let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
+        let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunImmediate
 
         Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)
 
@@ -455,7 +455,7 @@ type CompilerAssert private () =
     static member PassWithOptions options (source: string) =
         let options = { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}
 
-        let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunSynchronously
+        let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunImmediate
 
         Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)
 
@@ -473,7 +473,7 @@ type CompilerAssert private () =
                 0,
                 SourceText.ofString (File.ReadAllText absoluteSourceFile),
                 { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|sourceFile|] })
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)
 
@@ -503,7 +503,7 @@ type CompilerAssert private () =
                     0,
                     SourceText.ofString source,
                     { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|name|] })
-                |> Async.RunSynchronously
+                |> Async.RunImmediate
 
             if parseResults.Diagnostics.Length > 0 then
                 parseResults.Diagnostics
@@ -523,7 +523,7 @@ type CompilerAssert private () =
                     0,
                     SourceText.ofString source,
                     { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
-                |> Async.RunSynchronously
+                |> Async.RunImmediate
 
             if parseResults.Diagnostics.Length > 0 then
                 parseResults.Diagnostics
@@ -543,7 +543,7 @@ type CompilerAssert private () =
                 0,
                 SourceText.ofString source,
                 { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
-            |> Async.RunSynchronously
+            |> Async.RunImmediate
 
         match fileAnswer with
         | FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); failwith "Type Checker Aborted"
@@ -565,7 +565,7 @@ type CompilerAssert private () =
                     0,
                     SourceText.ofString source,
                     { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
-                |> Async.RunSynchronously
+                |> Async.RunImmediate
 
             if parseResults.Diagnostics.Length > 0 then
                 parseResults.Diagnostics
@@ -669,7 +669,7 @@ type CompilerAssert private () =
     static member Parse (source: string) =
         let sourceFileName = "test.fs"
         let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] }
-        checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunSynchronously
+        checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunImmediate
 
     static member ParseWithErrors (source: string) expectedParseErrors =
         let parseResults = CompilerAssert.Parse source

tests/FSharp.Test.Utilities/Utilities.fs

@@ -6,9 +6,10 @@ open System
 open System.IO
 open System.Reflection
 open System.Collections.Immutable
+open System.Diagnostics
+open System.Threading.Tasks
 open Microsoft.CodeAnalysis
 open Microsoft.CodeAnalysis.CSharp
-open System.Diagnostics
 open FSharp.Test.Utilities
 open TestFramework
 open NUnit.Framework
@@ -17,6 +18,19 @@ open NUnit.Framework
 
 module Utilities =
 
+    type Async with
+        static member RunImmediate (computation: Async<'T>, ?cancellationToken ) =
+            let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken
+            let ts = TaskCompletionSource<'T>()
+            let task = ts.Task
+            Async.StartWithContinuations(
+                computation,
+                (fun k -> ts.SetResult k),
+                (fun exn -> ts.SetException exn),
+                (fun _ -> ts.SetCanceled()),
+                cancellationToken)
+            task.Result
+
     [<RequireQualifiedAccess>]
     type TargetFramework =
         | NetStandard20