Skip to content

Commit 4288150

Browse files
safesparrowsafesparrow
committed
changes
1 parent 56e2301 commit 4288150

7 files changed

Lines changed: 37 additions & 16 deletions

File tree

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,8 @@ module Graph =
2525
|> Seq.map (fun node -> node, calcTransitiveEdges node)
2626
|> readOnlyDict
2727

28-
let reverse (graph : Graph<'Node>) : Graph<'Node> =
29-
graph
28+
let reverse (originalGraph : Graph<'Node>) : Graph<'Node> =
29+
originalGraph
3030
// Collect all edges
3131
|> Seq.collect (fun (KeyValue(idx, deps)) -> deps |> Array.map (fun dep -> idx, dep))
3232
// Group dependants of the same dependencies together
@@ -36,7 +36,7 @@ module Graph =
3636
|> dict
3737
// Add nodes that are missing due to having no dependants
3838
|> fun graph ->
39-
graph
39+
originalGraph
4040
|> Seq.map (fun (KeyValue(idx, deps)) ->
4141
match graph.TryGetValue idx with
4242
| true, dependants -> idx, dependants

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

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,11 +30,16 @@ type Node<'Item, 'State, 'Result> =
3030
/// <param name="transitiveDeps">Transitive dependencies of a node</param>
3131
/// <param name="folder">A way to fold a single result into existing state</param>
3232
let combineResults
33+
(emptyState : 'State)
3334
(deps : Node<'Item, 'State, 'Result>[])
3435
(transitiveDeps : Node<'Item, 'State, 'Result>[])
3536
(folder : 'State -> 'Result -> 'State)
3637
: 'State
3738
=
39+
match deps with
40+
| [||] -> emptyState
41+
| _ ->
42+
3843
let biggestDep =
3944
let sizeMetric node =
4045
// Could also use eg. total file size/AST size
@@ -54,7 +59,10 @@ let combineResults
5459

5560
// Add single-file results of remaining transitive deps one-by-one using folder
5661
// Note: Good to preserve order here so that folding happens in file order
57-
let included = HashSet(biggestDep.Info.TransitiveDeps)
62+
let included =
63+
let set = HashSet(biggestDep.Info.TransitiveDeps)
64+
set.Add biggestDep.Info.Item |> ignore
65+
set
5866
let resultsToAdd =
5967
transitiveDeps
6068
|> Array.filter (fun dep -> included.Contains dep.Info.Item = false)
@@ -71,6 +79,7 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
7179
(graph : Graph<'Item>)
7280
(doWork : 'Item -> 'State -> 'Result)
7381
(folder : 'State -> 'Result -> 'State)
82+
(emptyState : 'State)
7483
(parallelism : int)
7584
: 'State
7685
=
@@ -108,7 +117,7 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
108117
=
109118
let deps = lookupMany node.Info.Deps
110119
let transitiveDeps = lookupMany node.Info.TransitiveDeps
111-
let inputState = combineResults deps transitiveDeps folder
120+
let inputState = combineResults emptyState deps transitiveDeps folder
112121
let singleRes = doWork node.Info.Item inputState
113122
let state = folder inputState singleRes
114123
node.Result <- Some (state, singleRes)
@@ -123,7 +132,7 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
123132
x.ProcessedDepsCount <- x.ProcessedDepsCount + 1
124133
x.ProcessedDepsCount
125134
)
126-
pdc = node.Info.Deps.Length
135+
pdc = x.Info.Deps.Length
127136
)
128137
unblocked
129138

@@ -137,5 +146,5 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
137146
cts.Token
138147

139148
let nodesArray = nodes.Values |> Seq.toArray
140-
let state = combineResults nodesArray nodesArray folder
149+
let state = combineResults emptyState nodesArray nodesArray folder
141150
state

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

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -89,9 +89,13 @@ let processInParallel
8989
let processedCountLock = Object()
9090
let mutable processedCount = 0
9191
let processItem item =
92+
// printfn $"Processing {item}"
9293
let toSchedule = work item
9394
let processedCount = lock processedCountLock (fun () -> processedCount <- processedCount + 1; processedCount)
94-
toSchedule |> Array.iter bc.Add
95+
toSchedule
96+
|> Array.iter (
97+
fun next -> bc.Add(next)
98+
)
9599
processedCount
96100

97101
// TODO Could avoid workers with some semaphores
@@ -102,7 +106,7 @@ let processInParallel
102106
if stop processedCount then
103107
bc.CompleteAdding()
104108

105-
Array.Parallel.map workerWork |> ignore // use cancellation
109+
Array.Parallel.map workerWork (Array.init parallelism (fun _ -> ())) |> ignore // use cancellation
106110
()
107111

108112
let test () =

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ let typeCheckGraph (graph : FileGraph) : State =
2929
graph
3030
typeCheckFile
3131
folder
32+
""
3233
parallelism
3334
state
3435

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module FSharp.Compiler.Service.Tests2.Program
22

33
open System
4+
open FSharp.Compiler.Service.Tests
45

56
let runCompiler () =
67
Environment.CurrentDirectory <- "c:/projekty/fsharp/heuristic/src/Compiler"
@@ -11,6 +12,6 @@ let main _ =
1112
//runCompiler ()
1213
//TestDepResolving.TestHardcodedFiles()
1314
//TestDepResolving.TestProject(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj")
14-
TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
15-
//RunCompiler.runGrapher()
15+
//TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
16+
RunCompiler.runGrapher()
1617
0

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

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,10 +12,6 @@ let runCompiler () =
1212

1313
[<Test>]
1414
let runGrapher () =
15-
// let args =
16-
// System.IO.File.ReadAllLines(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.Service.Tests2\args.txt") |> Array.skip 1
17-
// FSharp.Compiler.CommandLineMain.main args |> ignore
18-
1915
let deps : Graph<int> =
2016
[|
2117
0, [||] // A
@@ -27,4 +23,12 @@ let runGrapher () =
2723
|]
2824
|> readOnlyDict
2925

30-
GraphProcessing.processGraph deps
26+
let state =
27+
GraphProcessing.processGraph
28+
deps
29+
(fun i state -> i)
30+
(fun state res -> $"{state}+{res}")
31+
""
32+
8
33+
34+
printfn $"End state: {state}"

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ type SourceFile =
1717
| :? SourceFile as p -> p.Name.Equals this.Name
1818
| _ -> false
1919
override this.GetHashCode () = this.Name.GetHashCode()
20+
override this.ToString() = this.Name
2021

2122
type SourceFiles = SourceFile[]
2223

@@ -37,5 +38,6 @@ type File =
3738
| :? File as f -> f.Name.Equals this.Name
3839
| _ -> false
3940
override this.GetHashCode () = this.Name.GetHashCode()
41+
override this.ToString() = this.Name
4042

4143
type Files = File[]

0 commit comments

Comments
 (0)