From c14b3e7cdb508b884dc43702942ed87ebd9c3c9b Mon Sep 17 00:00:00 2001
From: jindraivanek <jindra.ivanek@gmail.com>
Date: Sun, 28 Jan 2018 16:47:17 +0100
Subject: [PATCH] Minimize cycle + remove one node cycles

---
 src/Mechanic/GraphAlg.fs     | 23 ++++++++++++++++++++++-
 src/Mechanic/SymbolGetter.fs |  4 +++-
 src/Mechanic/SymbolGraph.fs  | 11 +++++++++--
 3 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/src/Mechanic/GraphAlg.fs b/src/Mechanic/GraphAlg.fs
index c00612f..70063c9 100644
--- a/src/Mechanic/GraphAlg.fs
+++ b/src/Mechanic/GraphAlg.fs
@@ -4,6 +4,24 @@ type TopologicalOrderResult<'a> =
     | TopologicalOrder of 'a list
     | Cycle of 'a list
 
+let getMinCycle (nodes: list<_>) edges = 
+    let choosePick f xs =
+        match xs |> List.choose id with
+        | [] -> None
+        | xs -> xs |> f |> Some
+    let rec getCycleAcc edgesMap path =
+        match path with
+        | [] -> failwith ""
+        | (v::vs) ->
+        match vs |> List.contains v with
+        | true -> Some vs
+        | false ->
+        let nodes = edgesMap |> Map.tryFind v |> Option.defaultValue []
+        nodes |> List.map (fun v -> getCycleAcc edgesMap (v :: path)) |> choosePick (Seq.minBy (List.length))
+
+    let edgesMap = edges |> Seq.groupBy fst |> Seq.map (fun (v,g) -> v, g |> Seq.map snd |> Seq.toList) |> Map.ofSeq
+    nodes |> List.map (fun v -> getCycleAcc edgesMap [v]) |> choosePick (Seq.minBy (List.length))
+
 let topologicalOrder orderedNodes edges =
     //TODO: maintain original order of nodes
     let nodes = orderedNodes |> set
@@ -22,7 +40,10 @@ let topologicalOrder orderedNodes edges =
         | [], 0 -> TopologicalOrder acc
         | (_ :: _), 0 -> 
             //TODO: remove nodes not part of cycle
-            Cycle (nodeLevels |> Map.toList |> List.map fst)
+            let cycleNodes = nodeLevels |> Map.toList |> List.map fst |> set
+            match getMinCycle (Set.toList cycleNodes) (edges |> List.filter (fun (v,w) -> Set.contains v cycleNodes && Set.contains w cycleNodes)) with
+            | Some c -> Cycle c
+            | None -> failwith ""
         | _ -> solve edges nodeLevels acc
     match solve edges nodeInLevel [] with
     | TopologicalOrder result ->
diff --git a/src/Mechanic/SymbolGetter.fs b/src/Mechanic/SymbolGetter.fs
index 0176aea..6a709bf 100644
--- a/src/Mechanic/SymbolGetter.fs
+++ b/src/Mechanic/SymbolGetter.fs
@@ -24,6 +24,8 @@ let getSymbols file =
     let tree = parseFileResults.ParseTree.Value
 
     let opens = AstSymbolCollector.getOpenDecls tree
-    let defSymbolNames = AstSymbolCollector.getDefSymbols tree |> set |> Set.toList |> List.filter (fun x -> x.StartsWith "op_" |> not)
+    let defSymbolNames = 
+        AstSymbolCollector.getDefSymbols tree |> set |> Set.toList 
+        |> List.filter (Utils.Namespace.lastPart >> (fun x -> x.StartsWith "op_") >> not)
 
     file, defSymbolNames, opens
diff --git a/src/Mechanic/SymbolGraph.fs b/src/Mechanic/SymbolGraph.fs
index f3e3b68..b6da5ca 100644
--- a/src/Mechanic/SymbolGraph.fs
+++ b/src/Mechanic/SymbolGraph.fs
@@ -2,6 +2,7 @@ module Mechanic.SymbolGraph
 open System.IO
 open Utils.Namespace
 open Mechanic.Utils
+open Mechanic.GraphAlg
 
 let getDependencies files =
     let depsData = files |> List.map SymbolGetter.getSymbols
@@ -49,14 +50,20 @@ let getDependencies files =
                 |> Option.map (fun (d,f) -> f, f2, d)
             uses2 |> List.choose tryFindDef
         )
-        |> List.groupBy (fun (f1, f2, _) -> f1, f2) |> List.map (fun ((f1, f2), xs) -> f1, f2, xs |> List.map (fun (_,_,x) -> x))
+        |> List.filter (fun (f1,f2,_) -> f1 <> f2) 
+        |> List.groupBy (fun (f1, f2, _) -> f1, f2) |> List.map (fun ((f1, f2), xs) -> 
+            f1, f2, xs |> List.map (fun (_,_,x) -> x) |> List.distinct)
     //printfn "%A" deps
     deps
 
 let solveOrder files =
     let deps = getDependencies files
     let edges = deps |> List.map (fun (f1,f2,_) -> f1, f2)
-    GraphAlg.topologicalOrder files edges
+    match GraphAlg.topologicalOrder files edges with
+    | TopologicalOrderResult.Cycle xs ->
+        printfn "Cycle with %A" (deps |> List.filter (fun (x,y,_) -> List.contains x xs && List.contains y xs))
+        TopologicalOrderResult.Cycle xs
+    | x-> x
 
 let solveOrderFromPattern root filePattern =
     Directory.EnumerateFiles(root,filePattern) |> Seq.toList