Merge pull request #65 from jindraivanek/min-cycle

Minimize cycle + remove one node cycles

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 =
     let orderPos = orderedNodes |> List.mapi (fun i v -> v, i) |> Map.ofList
     let nodes = orderedNodes |> set
@@ -16,7 +34,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 ""
         | _ -> 
             let next = 
                 zeroInLevelNodes |> Seq.sortBy (fun n -> orderPos.[n]) |> Seq.map (fun n ->

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

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