(* Implementation for "topol.mli" *)
(* Author: Piotr Wojtczak *)
(* Code review by Maciej Nadolski *)


open PMap


(* Exception thrown when the given graph is not acyclic *)

exception Cykliczne


(* Function creating a functional map  *)
(* structure from given adjacency list *)

let mapify l =
    let create a v = add v (0, []) a in
    let aux a (node, v) = List.fold_left create (add node (0, []) a) v in
    let base = List.fold_left aux empty l
    and attach = fun acc (node, children) ->
                    let old = snd (find node acc) in
                    add node (0, children @ old) acc in
    List.fold_left attach base l


(* Depth first search of a given graph          *)
(* While traversing it also sorts the vertices  *)
(* topologically and puts them in a list        *)

let rec dfs (acc, graph) node =
    match find node graph with
    | 1, _          -> raise Cykliczne
    | 2, _          -> (acc, graph)
    | 0, children   -> let new_acc, new_graph =
                    List.fold_left dfs (acc, add node (1, children) graph) children in
                    (node::new_acc, add node (2, children) new_graph)
    | _, _          -> failwith "Uknown behavior"


(* Function performing a topological sort over a given graph *)

let topol graph =
    let unpacked = mapify graph in
    fst (foldi (fun v _ a -> dfs a v) unpacked ([], unpacked))