(* $Header: /home/pauillac/formel1/fpottier/cvs/typo/topological.ml,v 1.1 2001/08/17 17:04:35 fpottier Exp $ *)

module type Graph = sig

  type node

  (* The client must allow associating an integer degree with every graph node. *)

  val get: node -> int
  val set: int -> node -> unit

  (* The client must allow enumerating all nodes. *)

  val iter: (node -> unit) -> unit

  (* The client must allow enumerating all successors of a given node. *)

  val successors: (node -> unit) -> node -> unit

end

(* Given an acyclic graph $G$, this functor provides functions which allow iterating over the graph in topological
   order. Each graph traversal has complexity $O(V+E)$, where $V$ is the number of vertices in the graph, and $E$ is
   the number of its edges. The graph must be acyclic; otherwise, [Cycle] will be raised at some point during every
   traversal. *)

module Sort (G : Graph) = struct

  (* Auxiliary function. *)

  let increment node =
    G.set (G.get node + 1) node

  (* The main iterator. *)

  exception Cycle

  let fold action accu =

    (* Compute each node's in degree. *)

    G.iter (G.set 0);
    G.iter (G.successors increment);

    (* Create a queue and fill it with all nodes of in-degree 0. At the same time, count all nodes in the graph. *)

    let count = ref 0 in
    let queue = Queue.create() in
    G.iter (fun node ->
      incr count;
      if G.get node = 0 then
	Queue.add node queue
    );

    (* Walk the graph, in topological order. *)

    let rec walk accu =
      if Queue.length queue = 0 then
	if !count > 0 then
	  raise Cycle
	else
	  accu
      else
	let node = Queue.take queue in
	let accu = action node accu in
	decr count;
	G.successors (fun successor ->
	  let degree = G.get successor - 1 in
	  G.set degree successor;
	  if degree = 0 then
	    Queue.add successor queue
        ) node;
	walk accu in

    walk accu

  let iter action =
    fold (fun node () -> action node) ()

end