WIP

Author: safesparrow

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

@@ -52,6 +52,30 @@ type DepsResult =
 
 type References = Reference seq
 
+let calcTransitiveGraph (graph : IDictionary<int, int[]>) : IDictionary<int, int[]> =
+    let transitiveDeps = Dictionary<int, int[]>()
+    
+    let rec calcTransitiveDepsInner (idx : int) =
+        match transitiveDeps.TryGetValue idx with
+        | true, deps -> deps
+        | false, _ ->
+            let directDeps = graph[idx]
+            let deps =
+                directDeps
+                |> Array.collect (
+                    fun dep ->
+                        calcTransitiveDepsInner dep
+                        |> Array.append [|dep|]
+                )
+                |> Array.distinct
+            transitiveDeps[idx] <- deps
+            deps
+    
+    graph.Keys
+    |> Seq.map (fun idx -> idx, calcTransitiveDepsInner idx)
+    |> dict
+
+
 /// Extract partial module references from partial module or type references
 let extractModuleSegments (stuff : ReferenceOrAbbreviation seq) : LongIdent[] * bool =
 
@@ -307,29 +331,8 @@ module internal AutomatedDependencyResolving =
             )
             |> dict
 
-        let transitiveDeps = Dictionary<int, int[]>()
-        
-        let rec calcTransitiveDeps (idx : int) =
-            match transitiveDeps.TryGetValue idx with
-            | true, deps -> deps
-            | false, _ ->
-                let directDeps = graph[idx]
-                let deps =
-                    directDeps
-                    |> Array.collect (
-                        fun dep ->
-                            calcTransitiveDeps dep
-                            |> Array.append [|dep|]
-                    )
-                    |> Array.distinct
-                transitiveDeps[idx] <- deps
-                deps
-        
         // Calculate transitive closure of the graph
-        let graph =
-            graph.Keys
-            |> Seq.map (fun idx -> idx, calcTransitiveDeps idx)
-            |> dict
+        let graph = calcTransitiveGraph graph
 
         let res =
             {

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

@@ -4,12 +4,13 @@ open System
 
 let runCompiler () =
     Environment.CurrentDirectory <- "c:/projekty/fsharp/heuristic/src/Compiler"
-    FSharp.Compiler.Service.Tests.RunCompiler.runCompiler()
+    RunCompiler.runCompiler()
 
 [<EntryPoint>]
 let main _ = 
     //TestDepResolving.TestProject(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj")
     //runCompiler ()
     //TestDepResolving.TestHardcodedFiles()
-    TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
+    //TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
+    RunCompiler.runGrapher()
     0

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

@@ -1,17 +1,18 @@
-module FSharp.Compiler.Service.Tests.RunCompiler
+module FSharp.Compiler.Service.Tests2.RunCompiler
 
 open System
 open System.Collections.Concurrent
 open System.Threading
 open System.Threading.Tasks
+open FSharp.Compiler.Service.Tests2
 open NUnit.Framework
 
 type Node =
     {
         Idx : int
         Deps : int[]
         Dependants : int[]
-        mutable Result : string option
+        mutable PartialResult : string option
         mutable UnprocessedDepsCount : int
         _lock : Object
     }
@@ -37,6 +38,10 @@ let runGrapher () =
             4, [|3|] // C2 -> C1
             5, [|2; 4|] // D -> B2, C2
         |]
+        |> dict
+        |> DepResolving.calcTransitiveGraph
+        |> Seq.map (fun (KeyValue(k, v)) -> k, v)
+        |> Seq.toArray
 
     let fileDependants =
         fileDeps
@@ -48,18 +53,18 @@ let runGrapher () =
         |> Array.map (fun (dep, edges) -> dep, edges |> Array.map fst)
         |> dict
         // Add nodes that are missing due to having no dependants
-        |> fun g ->
+        |> fun graph ->
             fileDeps
-            |> Array.map fst
-            |> Array.map (fun idx ->
-                match g.TryGetValue idx with
-                | true, dependants -> dependants
-                | false, _ -> [||]
+            |> Array.map (fun (idx, deps) ->
+                match graph.TryGetValue idx with
+                | true, dependants -> idx, dependants
+                | false, _ -> idx, [||]
             )
+        |> dict
 
     let graph =
         fileDeps
-        |> Seq.map (fun (idx, deps) -> idx, {Idx = idx; Deps = deps; Dependants = fileDependants[idx]; Result = None; UnprocessedDepsCount = deps.Length; _lock = Object()})
+        |> Seq.map (fun (idx, deps) -> idx, {Idx = idx; Deps = deps; Dependants = fileDependants[idx]; PartialResult = None; UnprocessedDepsCount = deps.Length; _lock = Object()})
         |> dict
 
     printfn "start"
@@ -83,16 +88,22 @@ let runGrapher () =
         )
 
     let actualWork (idx : int) =
-        idx.ToString()
+        let node = graph[idx]
+        let depsResult =
+            node.Deps
+            |> Array.map (fun dep -> match graph[dep].PartialResult with Some result -> result | None -> failwith $"Unexpected lack of result for a dependency {idx} -> {dep}")
+            |> Array.fold (fun state item -> state + item) ""
+        let thisResult = idx.ToString()
+        $"{thisResult}"
 
     // Processing of a single node/file - gives a result
     let go (idx : int) =
         let node = graph[idx]
         printfn $"Start {idx} -> %+A{node.Deps}"
         Thread.Sleep(500)
         let res = actualWork idx
-        node.Result <- Some res
-        printfn $" Stop {idx} work"
+        node.PartialResult <- Some res
+        printfn $" Stop {idx} work - result {res}"
 
         // Increment processed deps count for all dependants and schedule those who are now unblocked
         node.Dependants
@@ -133,5 +144,10 @@ let runGrapher () =
     q.CompleteAdding()
     printfn "waitall"
     Task.WaitAll workers
-    printfn "End"
-    ()
+    
+    let fullResult =
+        graph
+        |> Seq.map (fun (KeyValue(idx, node)) -> node.PartialResult |> Option.get) // TODO Oops
+        |> Seq.fold (fun state item -> state + item) ""
+    
+    printfn $"End result: {fullResult}"