Skip to content

Commit 54ab09a

Browse files
safesparrowsafesparrow
committed
WIP
1 parent b9e1dde commit 54ab09a

File tree

4 files changed

+100
-86
lines changed

4 files changed

+100
-86
lines changed

‎tests/FSharp.Compiler.Service.Tests2/DepResolving.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ type DepsResult =
5252

5353
type References = Reference seq
5454

55-
let calcTransitiveGraph (graph : IDictionary<int, int[]>) : IDictionary<int, int[]> =
55+
let calcTransitiveGraph (graph : IReadOnlyDictionary<int, int[]>) : IDictionary<int, int[]> =
5656
let transitiveDeps = Dictionary<int, int[]>()
5757

5858
let rec calcTransitiveDepsInner (idx : int) =

‎tests/FSharp.Compiler.Service.Tests2/FSharp.Compiler.Service.Tests2.fsproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@
3030
<Compile Include="TestASTVisit.fs" />
3131
<Compile Include="DepResolving.fs" />
3232
<Compile Include="TestDepResolving.fs" />
33+
<Compile Include="FileGraph.fs" />
3334
<Compile Include="RunCompiler.fs" />
3435
<None Include="Big.fs">
3536
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>

‎tests/FSharp.Compiler.Service.Tests2/FileGraph.fs‎

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
module FSharp.Compiler.Service.Tests.Graph
2+
3+
open System.Collections.Concurrent
4+
open System.Collections.Generic
5+
6+
type FileIdx =
7+
FileIdx of int
8+
with
9+
member this.Idx = match this with FileIdx idx -> idx
10+
override this.ToString() = this.Idx.ToString()
11+
static member make (idx : int) = FileIdx idx
12+
13+
/// <summary> DAG of files </summary>
14+
type FileGraph = IReadOnlyDictionary<FileIdx, FileIdx[]>
15+
16+
let memoize<'a, 'b when 'a : equality> f : ('a -> 'b) =
17+
let y = HashIdentity.Structural<'a>
18+
let d = new ConcurrentDictionary<'a, 'b>(y)
19+
fun x -> d.GetOrAdd(x, fun r -> f r)
20+
21+
module FileGraph =
22+
23+
let calcTransitiveGraph (graph : FileGraph) : FileGraph =
24+
let transitiveGraph = Dictionary<FileIdx, FileIdx[]>()
25+
26+
let rec calcTransitiveEdges =
27+
fun (idx : FileIdx) ->
28+
let edgeTargets = graph[idx]
29+
edgeTargets
30+
|> Array.collect calcTransitiveEdges
31+
|> Array.append edgeTargets
32+
|> Array.distinct
33+
|> memoize
34+
35+
graph.Keys
36+
|> Seq.iter (fun idx -> calcTransitiveEdges idx |> ignore)
37+
38+
transitiveGraph :> IReadOnlyDictionary<_,_>
39+
40+
let collectEdges (graph : FileGraph) =
41+
graph
42+
43+
let reverse (graph : FileGraph) : FileGraph =
44+
graph
45+
// Collect all edges
46+
|> Seq.collect (fun (KeyValue(idx, deps)) -> deps |> Array.map (fun dep -> idx, dep))
47+
// Group dependants of the same dependencies together
48+
|> Seq.groupBy (fun (idx, dep) -> dep)
49+
// Construct reversed graph
50+
|> Seq.map (fun (dep, edges) -> dep, edges |> Seq.map fst |> Seq.toArray)
51+
|> dict
52+
// Add nodes that are missing due to having no dependants
53+
|> fun graph ->
54+
graph
55+
|> Seq.map (fun (KeyValue(idx, deps)) ->
56+
match graph.TryGetValue idx with
57+
| true, dependants -> idx, dependants
58+
| false, _ -> idx, [||]
59+
)
60+
|> readOnlyDict
61+

‎tests/FSharp.Compiler.Service.Tests2/RunCompiler.fs‎

Lines changed: 37 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -5,68 +5,33 @@ open System.Collections.Concurrent
55
open System.Collections.Generic
66
open System.Threading
77
open System.Threading.Tasks
8-
open FSharp.Compiler.Service.Tests2
9-
open FSharp.Compiler.Service.Tests2.DepResolving
8+
open FSharp.Compiler.Service.Tests.Graph
109
open NUnit.Framework
1110

12-
type FileIdx =
13-
FileIdx of int
14-
with
15-
member this.Idx = match this with FileIdx idx -> idx
16-
override this.ToString() = this.Idx.ToString()
17-
static member make (idx : int) = FileIdx idx
18-
11+
[<Test>]
12+
let runCompiler () =
13+
let args =
14+
System.IO.File.ReadAllLines(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.Service.Tests2\args.txt") |> Array.skip 1
15+
FSharp.Compiler.CommandLineMain.main args |> ignore
16+
17+
[<CustomEquality; NoComparison>]
1918
type Node =
2019
{
2120
Idx : FileIdx
2221
Deps : FileIdx[]
2322
TransitiveDeps : FileIdx[]
2423
Dependants : FileIdx[]
2524
mutable PartialResult : string option
26-
mutable ThisResult : int
25+
mutable ThisResult : int option
2726
mutable UnprocessedDepsCount : int
2827
_lock : Object
2928
}
30-
with member this.GetHashCode() = this.Idx.Idx
31-
32-
[<Test>]
33-
let runCompiler () =
34-
let args =
35-
System.IO.File.ReadAllLines(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.Service.Tests2\args.txt") |> Array.skip 1
36-
FSharp.Compiler.CommandLineMain.main args |> ignore
37-
38-
39-
40-
/// <summary> DAG of files </summary>
41-
type FileGraph = IReadOnlyDictionary<FileIdx, FileIdx[]>
42-
43-
let memoize<'a, 'b when 'a : equality> f : ('a -> 'b) =
44-
let y = HashIdentity.Structural<'a>
45-
let d = new ConcurrentDictionary<'a, 'b>(y)
46-
fun x -> d.GetOrAdd(x, fun r -> f r)
29+
override this.Equals(y) =
30+
match y with
31+
| :? Node as other -> (this.Idx = other.Idx)
32+
| _ -> false
33+
override this.GetHashCode() = this.Idx.Idx
4734

48-
module FileGraph =
49-
50-
let calcTransitiveGraph (graph : FileGraph) : FileGraph =
51-
let transitiveGraph = Dictionary<FileIdx, FileIdx[]>()
52-
53-
let rec calcTransitiveEdges =
54-
fun (idx : FileIdx) ->
55-
let edgeTargets = graph[idx]
56-
edgeTargets
57-
|> Array.collect calcTransitiveEdges
58-
|> Array.append edgeTargets
59-
|> Array.distinct
60-
|> memoize
61-
62-
graph.Keys
63-
|> Seq.iter (fun idx -> calcTransitiveEdges idx |> ignore)
64-
65-
transitiveGraph :> IReadOnlyDictionary<_,_>
66-
67-
let collectEdges (graph : FileGraph) =
68-
graph
69-
7035
type State = string // TcState
7136
type SingleResult = int // partial result for a single file
7237

@@ -75,7 +40,7 @@ type SingleResult = int // partial result for a single file
7540
/// </summary>
7641
/// <param name="graph"></param>
7742
/// <param name="deps">Transitive deps</param>
78-
let combineResults (graph : IReadOnlyDictionary<FileIdx, Node>) (node : Node) (folder : State -> SingleResult -> State) : State =
43+
let combineResults (graph : IDictionary<FileIdx, Node>) (node : Node) (folder : State -> SingleResult -> State) : State =
7944

8045
// Find the child with most transitive deps
8146
let biggestChild =
@@ -93,9 +58,10 @@ let combineResults (graph : IReadOnlyDictionary<FileIdx, Node>) (node : Node) (f
9358
node.TransitiveDeps
9459
|> Array.filter alreadyIncluded.Add
9560

61+
// Add those results to the initial one
9662
let state =
9763
toBeAdded
98-
|> Array.map (fun d -> graph[d].ThisResult)
64+
|> Array.map (fun d -> graph[d].ThisResult |> Option.defaultWith (fun () -> failwith "Unexpected lack of result"))
9965
|> Array.fold folder state
10066

10167
state
@@ -125,23 +91,26 @@ let processGraph (graph : IDictionary<FileIdx, Node>) =
12591
let fold (state : string) (singleResult : int) =
12692
state + singleResult.ToString()
12793

94+
let actualActualWork (idx : FileIdx) (state : State) : SingleResult * State =
95+
let thisResult = idx.Idx
96+
let state = fold state thisResult
97+
thisResult, state
98+
12899
let actualWork (idx : FileIdx) =
129100
let node = graph[idx]
130-
let depsResult =
131-
node.Deps
132-
|> Array.map (fun dep -> match graph[dep].PartialResult with Some result -> result | None -> failwith $"Unexpected lack of result for a dependency {idx} -> {dep}")
133-
|> Array.fold fold ""
134-
let thisResult = idx.Idx
101+
let state = combineResults graph node fold
102+
let thisResult = actualActualWork idx state
135103
thisResult
136104

137105
// Processing of a single node/file - gives a result
138106
let go (idx : FileIdx) =
139107
let node = graph[idx]
140108
printfn $"Start {idx} -> %+A{node.Deps}"
141109
Thread.Sleep(500)
142-
let res = actualWork idx
143-
node.PartialResult <- Some res
144-
printfn $" Stop {idx} work - result {res}"
110+
let singleResult, state = actualWork idx
111+
node.ThisResult <- Some singleResult
112+
node.PartialResult <- Some state
113+
printfn $" Stop {idx} work - SingleResult={singleResult} State={state}"
145114

146115
// Increment processed deps count for all dependants and schedule those who are now unblocked
147116
node.Dependants
@@ -197,7 +166,7 @@ let runGrapher () =
197166
// System.IO.File.ReadAllLines(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.Service.Tests2\args.txt") |> Array.skip 1
198167
// FSharp.Compiler.CommandLineMain.main args |> ignore
199168

200-
let graph =
169+
let deps : FileGraph =
201170
[|
202171
0, [||] // A
203172
1, [|0|] // B1 -> A
@@ -206,34 +175,17 @@ let runGrapher () =
206175
4, [|3|] // C2 -> C1
207176
5, [|2; 4|] // D -> B2, C2
208177
|]
209-
|> dict
178+
|> Array.map (fun (a, deps) -> FileIdx.make a, deps |> Array.map FileIdx.make)
179+
|> readOnlyDict
210180

211-
let fileDeps =
212-
graph
213-
|> DepResolving.calcTransitiveGraph
214-
215-
let fileDependants =
216-
fileDeps
217-
// Collect all edges
218-
|> Seq.collect (fun (idx, deps) -> deps |> Array.map (fun dep -> FileIdx.make idx, FileIdx.make dep))
219-
// Group dependants of the same dependencies together
220-
|> Array.groupBy (fun (idx, dep) -> dep)
221-
// Construct reversed graph
222-
|> Array.map (fun (dep, edges) -> dep, edges |> Array.map fst)
223-
|> dict
224-
// Add nodes that are missing due to having no dependants
225-
|> fun graph ->
226-
fileDeps
227-
|> Array.map (fun (idx, deps) ->
228-
match graph.TryGetValue idx with
229-
| true, dependants -> idx, dependants
230-
| false, _ -> idx, [||]
231-
)
232-
|> dict
181+
let dependants = deps |> FileGraph.reverse
182+
183+
let transitiveDeps = deps |> FileGraph.calcTransitiveGraph
184+
let transitiveDependants = transitiveDeps |> FileGraph.reverse
233185

234186
let graph =
235-
fileDeps
236-
|> Seq.map (fun (idx, deps) -> idx, {Idx = idx; Deps = deps; Dependants = fileDependants[idx]; PartialResult = None; UnprocessedDepsCount = deps.Length; _lock = Object()})
187+
transitiveDeps
188+
|> Seq.map (fun (KeyValue(idx, deps)) -> idx, {Idx = idx; Deps = deps; Dependants = dependants[idx]; TransitiveDeps = transitiveDependants[idx]; ThisResult = None; PartialResult = None; UnprocessedDepsCount = deps.Length; _lock = Object()})
237189
|> dict
238190

239191
processGraph graph

0 commit comments

Comments
 (0)