Experiments 6 (#2)

- Added new LRU Cache supporting versions so we can allow GC of document and project related entries once new versions are observed without having to wait for cache capacity to be depleted.
- Hashing of cache keys (versions) - they could get pretty big with a lot of project references
- Removed MailboxProcessor from AsyncMemoize, replaced with SemaphoreSlim-based async lock
- Made the caches more debugger friendly by putting them under a single object that can be pinned and giving them a DebuggerDisplay
- Support for on-disk references (tracking DLL modified times)
- Graph processing (fork) uses TaskCompletionSource instead of cancellation to signal end of processing

src/Compiler/Driver/GraphChecking/GraphProcessing.fs

@@ -1,6 +1,9 @@
 module internal FSharp.Compiler.GraphChecking.GraphProcessing
 
 open System.Threading
+open FSharp.Compiler.GraphChecking
+open System.Threading.Tasks
+open System
 
 /// Information about the node in a graph, describing its relation with other nodes.
 type NodeInfo<'Item> =
@@ -32,6 +35,9 @@ type ProcessedNode<'Item, 'Result> =
         Result: 'Result
     }
 
+type GraphProcessingException(msg, ex: System.Exception) =
+    inherit exn(msg, ex)
+
 let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
     (graph: Graph<'Item>)
     (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result)
@@ -150,7 +156,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
     // If we stopped early due to an exception, reraise it.
     match getExn () with
     | None -> ()
-    | Some (item, ex) -> raise (System.Exception($"Encountered exception when processing item '{item}'", ex))
+    | Some (item, ex) -> raise (GraphProcessingException($"Encountered exception when processing item '{item}'", ex))
 
     // All calculations succeeded - extract the results and sort in input order.
     nodes.Values
@@ -173,6 +179,11 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
         // Cancellation source used to signal either an exception in one of the items or end of processing.
         let! parentCt = Async.CancellationToken
         use localCts = new CancellationTokenSource()
+
+        let completionSignal = TaskCompletionSource()
+
+        use _ = parentCt.Register(fun () -> completionSignal.TrySetCanceled() |> ignore)
+
         use cts = CancellationTokenSource.CreateLinkedTokenSource(parentCt, localCts.Token)
 
         let makeNode (item: 'Item) : GraphNode<'Item, 'Result> =
@@ -219,26 +230,18 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
 
         let processedCount = IncrementableInt(0)
 
-        /// Create a setter and getter for an exception raised in one of the work items.
-        /// Only the first exception encountered is stored - this can cause non-deterministic errors if more than one item fails.
-        let raiseExn, getExn =
-            let mutable exn: ('Item * System.Exception) option = None
-            let lockObj = obj ()
-            // Only set the exception if it hasn't been set already
-            let setExn newExn =
-                lock lockObj (fun () ->
-                    match exn with
-                    | Some _ -> ()
-                    | None -> exn <- newExn
-
-                    localCts.Cancel())
-
-            let getExn () = exn
-            setExn, getExn
+        let raiseExn (item, ex: exn) =
+            localCts.Cancel()
+            match ex with 
+            | :? OperationCanceledException ->
+                completionSignal.TrySetCanceled()
+            | _ -> 
+                completionSignal.TrySetException(GraphProcessingException($"[*] Encountered exception when processing item '{item}': {ex.Message}", ex))
+            |> ignore
 
         let incrementProcessedNodesCount () =
             if processedCount.Increment() = nodes.Count then
-                localCts.Cancel()
+                completionSignal.TrySetResult() |> ignore
 
         let rec queueNode node =
             Async.Start(
@@ -247,7 +250,7 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
 
                     match res with
                     | Choice1Of2 () -> ()
-                    | Choice2Of2 ex -> raiseExn (Some(node.Info.Item, ex))
+                    | Choice2Of2 ex -> raiseExn (node.Info.Item, ex)
                 },
                 cts.Token
             )
@@ -277,16 +280,8 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
         leaves |> Array.iter queueNode
 
         // Wait for end of processing, an exception, or an external cancellation request.
-
-        cts.Token.WaitHandle.WaitOne() |> ignore
-        // If we stopped early due to external cancellation, throw.
-        parentCt.ThrowIfCancellationRequested()
-
-        // If we stopped early due to an exception, reraise it.
-        match getExn () with
-        | None -> ()
-        | Some (item, ex) -> raise (System.Exception($"Encountered exception when processing item '{item}'", ex))
-
+        do! completionSignal.Task |> Async.AwaitTask 
+
         // All calculations succeeded - extract the results and sort in input order.
         return
             nodes.Values

src/Compiler/Driver/GraphChecking/GraphProcessing.fsi

@@ -15,6 +15,10 @@ type ProcessedNode<'Item, 'Result> =
     { Info: NodeInfo<'Item>
       Result: 'Result }
 
+type GraphProcessingException =
+    inherit exn
+    new: msg: string * ex: System.Exception -> GraphProcessingException
+
 /// <summary>
 /// A generic method to generate results for a graph of work items in parallel.
 /// Processes leaves first, and after each node has been processed, schedules any now unblocked dependants.

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -90,6 +90,7 @@
       <Link>FSStrings.resx</Link>
       <LogicalName>FSStrings.resources</LogicalName>
     </EmbeddedResource>
+
     <Compile Include="Utilities\Activity.fsi" />
     <Compile Include="Utilities\Activity.fs" />
     <Compile Include="Utilities\sformat.fsi" />
@@ -154,6 +155,7 @@
     <Compile Include="Facilities\CompilerLocation.fs" />
     <Compile Include="Facilities\BuildGraph.fsi" />
     <Compile Include="Facilities\BuildGraph.fs" />
+    <Compile Include="facilities\TaskAgent.fs" />
     <Compile Include="Facilities\AsyncMemoize.fs" />
     <FsLex Include="AbstractIL\illex.fsl">
       <OtherFlags>--module FSharp.Compiler.AbstractIL.AsciiLexer --internal --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.AbstractIL.AsciiParser --unicode --lexlib Internal.Utilities.Text.Lexing</OtherFlags>