Skip to content

Commit ce1fdea

Browse files
safesparrowsafesparrow
committed
cleanup + fantomas
1 parent 1f9384c commit ce1fdea

6 files changed

Lines changed: 103 additions & 124 deletions

File tree

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 26 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ type private PrivateNode<'Item, 'Result> =
1717
mutable ProcessedDepsCount: int
1818
mutable Result: 'Result option
1919
}
20-
20+
2121
type ProcessedNode<'Item, 'Result> =
2222
{
2323
Info: NodeInfo<'Item>
@@ -35,14 +35,13 @@ type ProcessedNode<'Item, 'Result> =
3535
/// <param name="ct">Cancellation token</param>
3636
/// <remarks>
3737
/// An alternative scheduling approach is to schedule N parallel tasks that process items from a BlockingCollection.
38-
/// My basic tests suggested it's faster, although confirming that would require more detailed testing.
38+
/// My basic tests suggested it's faster, although confirming that would require more detailed testing.
3939
/// </remarks>
4040
let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
4141
(graph: Graph<'Item>)
4242
(work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> 'Result)
4343
(ct: CancellationToken)
44-
: ('Item * 'Result)[] // Individual item results
45-
=
44+
: ('Item * 'Result)[] =
4645
let transitiveDeps = graph |> Graph.transitiveOpt
4746
let dependants = graph |> Graph.reverse
4847

@@ -70,44 +69,42 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
7069
ProcessedDepsCount = 0
7170
}
7271

73-
let nodes =
74-
graph.Keys
75-
|> Seq.map (fun item -> item, makeNode item)
76-
|> readOnlyDict
77-
let lookupMany items = items |> Array.map (fun item -> nodes[item])
72+
let nodes = graph.Keys |> Seq.map (fun item -> item, makeNode item) |> readOnlyDict
73+
74+
let lookupMany items =
75+
items |> Array.map (fun item -> nodes[item])
76+
7877
let leaves =
79-
nodes.Values
80-
|> Seq.filter (fun n -> n.Info.Deps.Length = 0)
81-
|> Seq.toArray
78+
nodes.Values |> Seq.filter (fun n -> n.Info.Deps.Length = 0) |> Seq.toArray
8279

8380
let waitHandle = new AutoResetEvent(false)
8481

8582
let getItemPublicNode item =
8683
let node = nodes[item]
84+
8785
{
8886
ProcessedNode.Info = node.Info
8987
ProcessedNode.Result =
9088
node.Result
9189
|> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available")
9290
}
93-
91+
9492
let incrementProcessedCount =
9593
let mutable processedCount = 0
94+
9695
fun () ->
9796
if Interlocked.Increment(&processedCount) = nodes.Count then
9897
waitHandle.Set() |> ignore
99-
98+
10099
let rec queueNode node =
101-
Async.Start(async {processNode node}, ct)
102-
103-
and processNode
104-
(node: PrivateNode<'Item, 'Result>)
105-
: unit =
100+
Async.Start(async { processNode node }, ct)
101+
102+
and processNode (node: PrivateNode<'Item, 'Result>) : unit =
106103
let info = node.Info
107-
104+
108105
let singleRes = work getItemPublicNode info
109106
node.Result <- Some singleRes
110-
107+
111108
let unblockedDependants =
112109
node.Info.Dependants
113110
|> lookupMany
@@ -118,21 +115,21 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
118115
let pdc = Interlocked.Increment(&dependant.ProcessedDepsCount)
119116
// Note: We cannot read 'dependant.ProcessedDepsCount' again to avoid returning the same item multiple times.
120117
pdc = dependant.Info.Deps.Length)
121-
118+
122119
unblockedDependants |> Array.iter queueNode
123-
incrementProcessedCount()
124-
120+
incrementProcessedCount ()
121+
125122
leaves |> Array.iter queueNode
126-
// TODO Handle async exceptions
123+
// TODO Handle async exceptions
127124
// q.Error += ...
128125
waitHandle.WaitOne() |> ignore
129-
126+
130127
nodes.Values
131128
|> Seq.map (fun node ->
132129
let result =
133130
node.Result
134131
|> Option.defaultWith (fun () -> failwith $"Unexpected lack of result for item '{node.Info.Item}'")
135-
node.Info.Item, result
136-
)
132+
133+
node.Info.Item, result)
137134
|> Seq.sortBy fst
138-
|> Seq.toArray
135+
|> Seq.toArray

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 7 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,6 @@
22

33
#nowarn "1182"
44

5-
open System
6-
open System.Collections.Concurrent
7-
open System.Collections.Generic
85
open System.IO
96
open System.Threading
107
open FSharp.Compiler
@@ -18,7 +15,6 @@ open FSharp.Compiler.ParseAndCheckInputs
1815
open ParallelTypeCheckingTests
1916
open FSharp.Compiler.Syntax
2017
open FSharp.Compiler.TcGlobals
21-
open FSharp.Compiler.Text
2218
open FSharp.Compiler.TypedTree
2319
open Internal.Utilities.Library
2420
open Internal.Utilities.Library.Extras
@@ -42,7 +38,7 @@ let folder (isFinalFold: bool) (state: State) (result: SingleResult) : FinalFile
4238
let CheckMultipleInputsInParallel
4339
((ctok, checkForErrors, tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs): 'a * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list)
4440
: FinalFileResult list * TcState =
45-
41+
4642
use cts = new CancellationTokenSource()
4743

4844
let sourceFiles: FileWithAST array =
@@ -70,7 +66,7 @@ let CheckMultipleInputsInParallel
7066
// |> Graph.map (fun idx -> sourceFiles.[idx].File)
7167
// |> Graph.serialiseToJson graphDumpPath
7268

73-
let _ = ctok // TODO Use
69+
let _ = ctok // TODO Use it
7470
let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
7571

7672
// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
@@ -85,12 +81,10 @@ let CheckMultipleInputsInParallel
8581
: bool -> State -> PartialResult * State =
8682
cancellable {
8783
use _ = UseDiagnosticsLogger logger
88-
// printfn $"Processing AST {file.ToString()}"
89-
// Is it OK that we don't update 'priorErrors' after processing batches?
84+
// TODO Is it OK that we don't update 'priorErrors' after processing batches?
9085
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
9186

9287
let tcSink = TcResultsSink.NoSink
93-
// let c = cnt
9488
cnt <- cnt + 1
9589

9690
// printfn $"#{c} [thread {Thread.CurrentThread.ManagedThreadId}] Type-checking {input.FileName}"
@@ -135,24 +129,15 @@ let CheckMultipleInputsInParallel
135129
input, logger)
136130

137131
let processFile (fileIdx: int) (state: State) : bool -> State -> PartialResult * State =
138-
let parsedInput, logger = inputsWithLoggers.[fileIdx]
132+
let parsedInput, logger = inputsWithLoggers[fileIdx]
139133
processFile (parsedInput, logger) state
140134

141-
let _qnof = QualifiedNameOfFile.QualifiedNameOfFile(Ident("", Range.Zero))
142135
let state: State = tcState, priorErrors
143136

144137
let partialResults, (tcState, _) =
145-
TypeCheckingGraphProcessing.processFileGraph<int, State, SingleResult, FinalFileResult>
146-
graph
147-
processFile
148-
folder
149-
state
150-
cts.Token
138+
TypeCheckingGraphProcessing.processFileGraph<int, State, SingleResult, FinalFileResult> graph processFile folder state cts.Token
151139

152140
let partialResults =
153-
partialResults
154-
|> Array.sortBy fst
155-
|> Array.map snd
156-
|> Array.toList
157-
141+
partialResults |> Array.sortBy fst |> Array.map snd |> Array.toList
142+
158143
partialResults, tcState)

‎tests/ParallelTypeCheckingTests/Code/TypeCheckingGraphProcessing.fs‎

Lines changed: 18 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
/// Parallel processing of graph of work items with dependencies
22
module ParallelTypeCheckingTests.TypeCheckingGraphProcessing
33

4-
open System.IO
54
open ParallelTypeCheckingTests.GraphProcessing
65
open System.Collections.Generic
76
open System.Threading
@@ -28,10 +27,8 @@ let private combineResults
2827
| [||] -> emptyState
2928
| _ ->
3029
let biggestDep =
31-
let sizeMetric (node: ProcessedNode<_,_>) =
32-
node.Info.TransitiveDeps.Length
33-
deps
34-
|> Array.maxBy sizeMetric
30+
let sizeMetric (node: ProcessedNode<_, _>) = node.Info.TransitiveDeps.Length
31+
deps |> Array.maxBy sizeMetric
3532

3633
let firstState = biggestDep.Result |> fst
3734

@@ -53,28 +50,34 @@ let private combineResults
5350
state
5451

5552
// TODO This function and its parameters are quite specific to type-checking despite using generic types.
56-
// Perhaps we should make it either more specific and remove type parameters, or more generic.
53+
// Perhaps we should make it either more specific and remove type parameters, or more generic.
54+
/// <summary>
55+
/// Process a graph of items.
56+
/// A version of 'GraphProcessing.processGraph' specific to type-checking.
57+
/// </summary>
5758
let processFileGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality and 'Item: comparison>
5859
(graph: Graph<'Item>)
59-
(doWork: 'Item -> 'State -> 'Result)
60+
(work: 'Item -> 'State -> 'Result)
6061
(folder: bool -> 'State -> 'Result -> 'FinalFileResult * 'State)
6162
(emptyState: 'State)
6263
(ct: CancellationToken)
6364
: ('Item * 'FinalFileResult)[] * 'State =
6465

65-
let work
66-
(getFinishedNode: 'Item -> ProcessedNode<'Item, 'State * 'Result>)
67-
(node: NodeInfo<'Item>)
68-
: 'State * 'Result =
66+
let workWrapper (getProcessedNode: 'Item -> ProcessedNode<'Item, 'State * 'Result>) (node: NodeInfo<'Item>) : 'State * 'Result =
6967
let folder x y = folder false x y |> snd
70-
let deps = node.Deps |> Array.except [|node.Item|] |> Array.map getFinishedNode
71-
let transitiveDeps = node.TransitiveDeps|> Array.except [|node.Item|] |> Array.map getFinishedNode
68+
let deps = node.Deps |> Array.except [| node.Item |] |> Array.map getProcessedNode
69+
70+
let transitiveDeps =
71+
node.TransitiveDeps
72+
|> Array.except [| node.Item |]
73+
|> Array.map getProcessedNode
74+
7275
let inputState = combineResults emptyState deps transitiveDeps folder
73-
let singleRes = doWork node.Item inputState
76+
let singleRes = work node.Item inputState
7477
let state = folder inputState singleRes
7578
state, singleRes
7679

77-
let results = processGraph graph work ct
80+
let results = processGraph graph workWrapper ct
7881

7982
let finals, state: ('Item * 'FinalFileResult)[] * 'State =
8083
results

‎tests/ParallelTypeCheckingTests/Program.fs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@ let parse (argv: string[]) : Args =
2323

2424
[<EntryPoint>]
2525
let main argv =
26-
FSharp.Compiler.ParseAndCheckInputs.CheckMultipleInputsUsingGraphMode <-
27-
ParallelTypeChecking.CheckMultipleInputsInParallel
26+
FSharp.Compiler.ParseAndCheckInputs.CheckMultipleInputsUsingGraphMode <- ParallelTypeChecking.CheckMultipleInputsInParallel
2827
let args = parse argv
2928
TestCompilationFromCmdlineArgs.TestCompilerFromArgs args
30-
0
29+
0

‎tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,7 @@ open FSharp.Compiler
88
open ParallelTypeCheckingTests
99
open ParallelTypeCheckingTests.TestUtils
1010

11-
type Codebase =
12-
{
13-
WorkDir: string
14-
Path: string
15-
}
11+
type Codebase = { WorkDir: string; Path: string }
1612

1713
let codebases =
1814
[|
@@ -35,8 +31,7 @@ let internal setupParsed config =
3531
config
3632

3733
let args =
38-
System.IO.File.ReadAllLines(path |> replacePaths)
39-
|> Array.map replacePaths
34+
System.IO.File.ReadAllLines(path |> replacePaths) |> Array.map replacePaths
4035

4136
setupCompilationMethod method
4237

0 commit comments

Comments
 (0)