Skip to content

Commit a20c50d

Browse files
safesparrowsafesparrow
committed
Cleanup, updated a few comments.
1 parent 6c5af5d commit a20c50d

File tree

8 files changed

+109
-91
lines changed

8 files changed

+109
-91
lines changed

‎tests/ParallelTypeCheckingTests/Code/DependencyResolution.fs‎

Lines changed: 12 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,6 @@
33
open FSharp.Compiler.Syntax
44
open ParallelTypeCheckingTests
55

6-
// This is pseudo code of how we could restructure the trie code
7-
// My main benefit is that you can easily visually inspect if an identifier will match something in the trie
8-
96
// This code just looks for a path in the trie
107
// It could be cached and is easy to reason about.
118
let queryTrie (trie: TrieNode) (path: ModuleSegment list) : QueryTrieNodeResult =
@@ -58,7 +55,7 @@ let processIdentifier (queryTrie: QueryTrie) (path: ModuleSegment list) (state:
5855
match queryResult with
5956
| QueryTrieNodeResult.NodeDoesNotExist -> state
6057
| QueryTrieNodeResult.NodeDoesNotExposeData ->
61-
// This can occur when you are have a file that uses a known namespace (for example namespace System).
58+
// This can occur when you have a file that uses a known namespace (for example namespace System).
6259
// When any other code uses that System namespace it won't find anything in the user code.
6360
state
6461
| QueryTrieNodeResult.NodeExposesData files -> state.AddDependencies files
@@ -114,17 +111,10 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState)
114111
}
115112

116113
let getFileNameBefore (files: FileWithAST array) idx =
117-
files.[0 .. (idx - 1)] |> Array.map (fun f -> f.Idx) |> Set.ofArray
118-
119-
let time msg f a =
120-
let sw = System.Diagnostics.Stopwatch.StartNew()
121-
let result = f a
122-
sw.Stop()
123-
printfn $"{msg} took %A{sw.Elapsed.Milliseconds}ms"
124-
result
114+
files[0 .. (idx - 1)] |> Array.map (fun f -> f.Idx) |> Set.ofArray
125115

126-
/// Returns a list of all the files that child nodes contain
127-
let indexesUnderNode (node: TrieNode) : Set<int> =
116+
/// Returns files contain in any node of the given Trie
117+
let indicesUnderNode (node: TrieNode) : Set<int> =
128118
let rec collect (node: TrieNode) (continuation: int list -> int list) : int list =
129119
let continuations: ((int list -> int list) -> int list) list =
130120
[
@@ -139,10 +129,15 @@ let indexesUnderNode (node: TrieNode) : Set<int> =
139129

140130
Set.ofList (collect node id)
141131

132+
/// <summary>
133+
/// For a given file's content, find all missing ("ghost") file dependencies that are required to satisfy the type-checker.
134+
/// </summary>
135+
/// <remarks>
142136
/// A "ghost" dependency is a link between files that actually should be avoided.
143137
/// The user has a partial namespace or opens a namespace that does not produce anything.
144138
/// In order to still be able to compile the current file, the given namespace should be known to the file.
145139
/// We did not find it via the trie, because there are no files that contribute to this namespace.
140+
/// </remarks>
146141
let collectGhostDependencies (fileIndex: int) (trie: TrieNode) (queryTrie: QueryTrie) (result: FileContentQueryState) =
147142
// Go over all open namespaces, and assert all those links eventually went anywhere
148143
Set.toArray result.OpenedNamespaces
@@ -156,11 +151,11 @@ let collectGhostDependencies (fileIndex: int) (trie: TrieNode) (queryTrie: Query
156151
let rec visit (node: TrieNode) (path: ModuleSegment list) =
157152
match path with
158153
| [] -> node
159-
| head :: tail -> visit node.Children.[head] tail
154+
| head :: tail -> visit node.Children[head] tail
160155

161156
visit trie path
162157

163-
let children = indexesUnderNode node |> Set.filter (fun idx -> idx < fileIndex)
158+
let children = indicesUnderNode node |> Set.filter (fun idx -> idx < fileIndex)
164159
let intersection = Set.intersect result.FoundDependencies children
165160

166161
if Set.isEmpty intersection then
@@ -193,7 +188,7 @@ let mkGraph (filePairs: FilePairMap) (files: FileWithAST array) : Graph<int> =
193188
let fileContents = Array.Parallel.map FileContentMapping.mkFileContent files
194189

195190
let findDependencies (file: FileWithAST) : int * int array =
196-
let fileContent = fileContents.[file.Idx]
191+
let fileContent = fileContents[file.Idx]
197192
let knownFiles = getFileNameBefore files file.Idx
198193
let filesFromRoot = trie.Files |> Set.filter (fun rootIdx -> rootIdx < file.Idx)
199194

‎tests/ParallelTypeCheckingTests/Code/FileContentMapping.fs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
open FSharp.Compiler.Syntax
44
open FSharp.Compiler.SyntaxTreeOps
5+
open ParallelTypeCheckingTests
56

67
type Continuations = ((FileContentEntry list -> FileContentEntry list) -> FileContentEntry list) list
78

‎tests/ParallelTypeCheckingTests/Code/Graph.fs‎

Lines changed: 3 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ open System.Collections.Generic
88
open System.IO
99
open Newtonsoft.Json
1010

11-
/// <summary> DAG of files </summary>
11+
/// <summary> Directed Acyclic Graph (DAG) of arbitrary nodes </summary>
1212
type Graph<'Node> = IReadOnlyDictionary<'Node, 'Node[]>
1313

1414
module Graph =
@@ -48,7 +48,7 @@ module Graph =
4848
addIfMissing missingNodes graph
4949

5050
/// Create a transitive closure of the graph
51-
let transitiveOpt<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
51+
let transitive<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
5252
let go (node: 'Node) =
5353
let visited = HashSet<'Node>()
5454

@@ -63,33 +63,13 @@ module Graph =
6363
|> Array.Parallel.map (fun node -> node, go node)
6464
|> readOnlyDict
6565

66-
/// Create a transitive closure of the graph
67-
let transitive<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
68-
let rec calcTransitiveEdges =
69-
fun (node: 'Node) ->
70-
let edgeTargets =
71-
match graph.TryGetValue node with
72-
| true, x -> x
73-
| false, _ -> failwith "FOO"
74-
75-
edgeTargets
76-
|> Array.collect calcTransitiveEdges
77-
|> Array.append edgeTargets
78-
|> Array.distinct
79-
// Dispose of memoisation context
80-
|> memoize
81-
82-
graph.Keys
83-
|> Seq.map (fun node -> node, calcTransitiveEdges node)
84-
|> readOnlyDict
85-
8666
/// Create a reverse of the graph
8767
let reverse (originalGraph: Graph<'Node>) : Graph<'Node> =
8868
originalGraph
8969
// Collect all edges
9070
|> Seq.collect (fun (KeyValue (idx, deps)) -> deps |> Array.map (fun dep -> idx, dep))
9171
// Group dependants of the same dependencies together
92-
|> Seq.groupBy (fun (_idx, dep) -> dep)
72+
|> Seq.groupBy snd
9373
// Construct reversed graph
9474
|> Seq.map (fun (dep, edges) -> dep, edges |> Seq.map fst |> Seq.toArray)
9575
|> readOnlyDict

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 47 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module ParallelTypeCheckingTests.GraphProcessing
33

44
open System.Threading
55

6+
/// Information about the node in a graph, describing its relation with other nodes.
67
type NodeInfo<'Item> =
78
{
89
Item: 'Item
@@ -11,13 +12,23 @@ type NodeInfo<'Item> =
1112
Dependants: 'Item[]
1213
}
1314

14-
type private PrivateNode<'Item, 'Result> =
15+
type IncrementableInt(value: int) =
16+
let mutable value = value
17+
with
18+
member this.Value = value
19+
// Increment the value in a thread-safe manner and return the new value.
20+
member this.Increment() =
21+
Interlocked.Increment (&value)
22+
23+
type private GraphNode<'Item, 'Result> =
1524
{
1625
Info: NodeInfo<'Item>
17-
mutable ProcessedDepsCount: int
26+
/// Used to determine when all dependencies of this node have been resolved.
27+
ProcessedDepsCount: IncrementableInt
1828
mutable Result: 'Result option
1929
}
2030

31+
/// An already processed node in the graph, with its result available
2132
type ProcessedNode<'Item, 'Result> =
2233
{
2334
Info: NodeInfo<'Item>
@@ -40,13 +51,12 @@ type ProcessedNode<'Item, 'Result> =
4051
let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
4152
(graph: Graph<'Item>)
4253
(work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result)
43-
(includeInFinalState: 'Item -> bool)
4454
(ct: CancellationToken)
4555
: ('Item * 'Result)[] =
46-
let transitiveDeps = graph |> Graph.transitiveOpt
56+
let transitiveDeps = graph |> Graph.transitive
4757
let dependants = graph |> Graph.reverse
4858

49-
let makeNode (item: 'Item) : PrivateNode<'Item, 'Result> =
59+
let makeNode (item: 'Item) : GraphNode<'Item, 'Result> =
5060
let info =
5161
let exists = graph.ContainsKey item
5262

@@ -67,7 +77,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
6777
{
6878
Info = info
6979
Result = None
70-
ProcessedDepsCount = 0
80+
ProcessedDepsCount = IncrementableInt(0)
7181
}
7282

7383
let nodes = graph.Keys |> Seq.map (fun item -> item, makeNode item) |> readOnlyDict
@@ -78,7 +88,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
7888
let leaves =
7989
nodes.Values |> Seq.filter (fun n -> n.Info.Deps.Length = 0) |> Seq.toArray
8090

81-
let waitHandle = new AutoResetEvent(false)
91+
let waitHandle = new ManualResetEventSlim(false)
8292

8393
let getItemPublicNode item =
8494
let node = nodes[item]
@@ -90,17 +100,30 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
90100
|> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available")
91101
}
92102

93-
let incrementProcessedCount =
94-
let mutable processedCount = 0
95-
96-
fun () ->
97-
if Interlocked.Increment(&processedCount) = nodes.Count then
98-
waitHandle.Set() |> ignore
103+
let processedCount = IncrementableInt(0)
104+
let mutable exn : ('Item * System.Exception) option = None
105+
let incrementProcessedNodesCount () =
106+
if processedCount.Increment() = nodes.Count then
107+
waitHandle.Set() |> ignore
99108

100109
let rec queueNode node =
101-
Async.Start(async { processNode node }, ct)
110+
Async.Start(
111+
async {
112+
let! res =
113+
async {
114+
processNode node
115+
}
116+
|> Async.Catch
117+
match res with
118+
| Choice1Of2 () -> ()
119+
| Choice2Of2 ex ->
120+
exn <- Some (node.Info.Item, ex)
121+
waitHandle.Set() |> ignore
122+
}
123+
,ct)
102124

103-
and processNode (node: PrivateNode<'Item, 'Result>) : unit =
125+
and processNode (node: GraphNode<'Item, 'Result>) : unit =
126+
104127
let info = node.Info
105128

106129
let singleRes = work getItemPublicNode info
@@ -112,21 +135,22 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
112135
// For every dependant, increment its number of processed dependencies,
113136
// and filter dependants which now have all dependencies processed (but didn't before).
114137
|> Array.filter (fun dependant ->
115-
// This counter can be incremented by multiple workers on different threads.
116-
let pdc = Interlocked.Increment(&dependant.ProcessedDepsCount)
138+
let pdc = dependant.ProcessedDepsCount.Increment()
117139
// Note: We cannot read 'dependant.ProcessedDepsCount' again to avoid returning the same item multiple times.
118140
pdc = dependant.Info.Deps.Length)
119141

120142
unblockedDependants |> Array.iter queueNode
121-
incrementProcessedCount ()
122-
143+
incrementProcessedNodesCount ()
144+
123145
leaves |> Array.iter queueNode
124-
// TODO Handle async exceptions
125-
// q.Error += ...
126-
waitHandle.WaitOne() |> ignore
146+
147+
waitHandle.Wait(ct) |> ignore
148+
match exn with
149+
| None -> ()
150+
| Some (item, ex) ->
151+
raise (System.Exception($"Encountered exception when processing item '{item}'", ex))
127152

128153
nodes.Values
129-
|> Seq.filter (fun node -> includeInFinalState node.Info.Item)
130154
|> Seq.map (fun node ->
131155
let result =
132156
node.Result

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -200,26 +200,32 @@ let CheckMultipleInputsInParallel
200200
let processFile (node: NodeToTypeCheck) (state: State) : State -> PartialResult * State =
201201
match node with
202202
| NodeToTypeCheck.ArtificialImplFile idx ->
203-
let parsedInput, _ = inputsWithLoggers.[idx]
203+
let parsedInput, _ = inputsWithLoggers[idx]
204204
processArtificialImplFile parsedInput state
205205
| NodeToTypeCheck.PhysicalFile idx ->
206-
let parsedInput, logger = inputsWithLoggers.[idx]
206+
let parsedInput, logger = inputsWithLoggers[idx]
207207
processFile (parsedInput, logger) state
208208

209209
let state: State = tcState, priorErrors
210210

211+
let finalStateItemChooser node =
212+
match node with
213+
| NodeToTypeCheck.ArtificialImplFile _ -> None
214+
| NodeToTypeCheck.PhysicalFile file -> Some file
215+
211216
let partialResults, (tcState, _) =
212-
TypeCheckingGraphProcessing.processFileGraph<NodeToTypeCheck, State, SingleResult, FinalFileResult>
217+
TypeCheckingGraphProcessing.processTypeCheckingGraph<NodeToTypeCheck, int, State, SingleResult, FinalFileResult>
213218
nodeGraph
214219
processFile
215220
folder
216-
(function
217-
| NodeToTypeCheck.ArtificialImplFile _ -> false
218-
| NodeToTypeCheck.PhysicalFile _ -> true)
221+
finalStateItemChooser
219222
state
220223
cts.Token
221224

222225
let partialResults =
223-
partialResults |> Array.sortBy fst |> Array.map snd |> Array.toList
226+
partialResults
227+
// Bring back the original, index-based file order.
228+
|> List.sortBy fst
229+
|> List.map snd
224230

225231
partialResults, tcState)

‎tests/ParallelTypeCheckingTests/Code/TrieMapping.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ let private doesFileExposeContentToTheRoot (ast: ParsedInput) : bool =
5656
let mergeTrieNodes (defaultChildSize: int) (tries: TrieNode array) =
5757
let rec mergeTrieNodesAux (root: TrieNode) (KeyValue (k, v)) =
5858
if root.Children.ContainsKey k then
59-
let node = root.Children.[k]
59+
let node = root.Children[k]
6060

6161
match node.Current, v.Current with
6262
| TrieNodeInfo.Namespace (filesThatExposeTypes = currentFiles), TrieNodeInfo.Namespace (filesThatExposeTypes = otherFiles) ->

0 commit comments

Comments
 (0)