let scc_roots iter_roots =
let root = H.create 997 in
let hashcomp = H.create 997 in
let stack = ref [] in
let numdfs = ref 0 in
let numcomp = ref 0 in
let rec pop x c = function
| (y, w) :: l when y > x ->
H.add hashcomp w !numcomp;
pop x (S.add w c) l
| l -> c,l
in
let rec visit v =
if not (H.mem root v) then
begin
let n = incr numdfs; !numdfs in
H.add root v n;
G.iter_succ
(fun w ->
visit w;
if not (H.mem hashcomp w) then
H.replace root v (min (H.find root v) (H.find root w)))
v;
if H.find root v = n then
(H.add hashcomp v !numcomp;
let _,s = pop n (S.add v S.empty) !stack in
stack:= s;
incr numcomp)
else stack := (n,v)::!stack;
end
in
iter_roots visit ;
let t = Array.make !numcomp [] in
H.iter
(fun v i -> t.(i) <- v::t.(i))
hashcomp ; t