Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/idlbasis-devel/src/MLRISC/graphs/graph-bcc.sml
ViewVC logotype

Annotation of /sml/branches/idlbasis-devel/src/MLRISC/graphs/graph-bcc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 848 - (view) (download)

1 : monnier 409 (*
2 :     * Tarjan's algorithm for computing biconnected components.
3 :     *
4 :     * -- Allen
5 :     *)
6 :     structure GraphBCC : GRAPH_BICONNECTED_COMPONENTS =
7 :     struct
8 :    
9 :     structure G = Graph
10 :     structure A = Array
11 :    
12 :     fun biconnected_components (G.GRAPH G) process S =
13 :     let val N = #capacity G ()
14 :     val dfsnum = A.array(N,~1)
15 :     val low = A.array(N,~1)
16 :     fun dfsRoots([],stack,n,S) = (stack,n,S)
17 :     | dfsRoots((r,_)::roots,stack,n,S) =
18 :     if A.sub(dfsnum,r) < 0 then
19 :     let val (stack,n,S) = dfs(~1,r,stack,n,S)
20 :     in dfsRoots(roots,stack,n,S) end
21 :     else dfsRoots(roots,stack,n,S)
22 :     and dfs(p,v,stack,n,S) =
23 :     let val _ = A.update(dfsnum,v,n)
24 :     val _ = A.update(low,v,n)
25 :     fun min(k) = let val v' = A.sub(low,v)
26 :     in if k < v' then A.update(low,v,k) else () end
27 :     fun visit([],stack,n,S) = (stack,n,S)
28 :     | visit((e as (_,w,_))::es,stack,n,S) =
29 :     let val d_w = A.sub(dfsnum,w)
30 :     in if A.sub(dfsnum,w) < 0 then
31 :     let val (stack,n,S) = dfs(v,w,stack,n,S)
32 :     in min(A.sub(low,w)); visit(es,stack,n,S) end
33 :     else (min d_w; visit(es,stack,n,S))
34 :     end
35 :     fun visit'([],stack,n,S) = (stack,n,S)
36 :     | visit'((e as (w,_,_))::es,stack,n,S) =
37 :     let val d_w = A.sub(dfsnum,w)
38 :     in if A.sub(dfsnum,w) < 0 then
39 :     let val (stack,n,S) = dfs(v,w,stack,n,S)
40 :     in min(A.sub(low,w)); visit'(es,stack,n,S) end
41 :     else (min d_w; visit'(es,stack,n,S))
42 :     end
43 :     val (stack,n,S) = visit(#out_edges G v,v::stack,n+1,S)
44 :     val (stack,n,S) = visit'(#in_edges G v,stack,n,S)
45 :     in if p >= 0 andalso A.sub(low,v) = A.sub(dfsnum,p) then
46 :     let fun loop([],C) = ([],C)
47 :     | loop(w::stack,C) =
48 :     let val d_w = A.sub(dfsnum,w)
49 :     val C = foldr (fn (e as (_,w',_),C) =>
50 :     if d_w > A.sub(dfsnum,w') then e::C else C)
51 :     C (#out_edges G w)
52 :     val C = foldr (fn (e as (w',_,_),C) =>
53 :     if d_w > A.sub(dfsnum,w') then e::C else C)
54 :     C (#in_edges G w)
55 :     in if w <> v then loop(stack,C) else (stack,C) end
56 :     val (stack,C) = loop(stack,[])
57 :     in (stack,n,process(C,S)) end
58 :     else (stack,n,S)
59 :     end
60 :    
61 :     val (_,_,S) = dfsRoots(#nodes G (),[],0,S)
62 :     in S
63 :     end
64 :    
65 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0