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/trunk/src/comp-lib/scc.sml
 [smlnj] / sml / trunk / src / comp-lib / scc.sml

# Annotation of /sml/trunk/src/comp-lib/scc.sml

Revision 419 - (view) (download)

 1 : monnier 245 (* scc.sml 2 : * 3 : * COPYRIGHT (c) 1996 Bell Laboratories. 4 : * 5 : * Calculate strongly-connected components of directed graph. 6 : * The graph can have nodes with self-loops. 7 : * 8 : * author: Matthias Blume 9 : * 10 : *) 11 : 12 : signature SCCNODE = sig 13 : type node 14 : val eq: node * node -> bool 15 : val lt: node * node -> bool 16 : end 17 : 18 : signature SCC = sig 19 : 20 : structure Node: SCCNODE 21 : 22 : datatype component = 23 : SIMPLE of Node.node (* singleton, no self-loop *) 24 : | RECURSIVE of Node.node list 25 : 26 : (* take root node and follow function and return 27 : * list of topologically sorted strongly-connected components; 28 : * root component goes first *) 29 : val topOrder: 30 : { root: Node.node, follow: Node.node -> Node.node list } -> 31 : component list 32 : end 33 : 34 : functor SCCUtilFun (structure Node: SCCNODE): SCC = struct 35 : 36 : exception SccBug 37 : 38 : structure Node = Node 39 : 40 : structure NodeOrdSet = struct 41 : monnier 411 type ord_key = Node.node 42 : fun compare(n1, n2) = 43 : if Node.eq(n1,n2) then General.EQUAL 44 : else if Node.lt(n1,n2) then General.LESS 45 : else General.GREATER 46 : monnier 245 end 47 : 48 : monnier 411 structure Map = BinaryMapFn(NodeOrdSet) 49 : monnier 245 50 : type node = Node.node 51 : 52 : datatype component = 53 : SIMPLE of node 54 : | RECURSIVE of node list 55 : 56 : fun topOrder { root, follow } = let 57 : 58 : fun getNode (n, nm as (npre, m)) = 59 : monnier 411 (case Map.find(m, n) 60 : of NONE => let 61 : val r = { pre = npre, low = ref npre } 62 : val m' = Map.insert (m, n, r) 63 : in ((npre + 1, m'), r) 64 : end 65 : | SOME r => (nm, r) 66 : (*esac*)) 67 : monnier 245 68 : fun theNode x y = Node.eq (x, y) 69 : 70 : fun component (x, []) = 71 : if List.exists (theNode x) (follow x) then 72 : RECURSIVE [x] 73 : else 74 : SIMPLE x 75 : | component (x, xl) = RECURSIVE (x :: xl) 76 : 77 : (* depth-first search in continuation-passing, state-passing style *) 78 : fun dfs args = let 79 : 80 : (* the nodemap represents the mapping from nodes to 81 : * pre-order numbers and low-numbers. The latter are ref-cells. 82 : * nodemap also remembers the next available pre-order number. *) 83 : val { node, node_pre, node_low, parent_low, nodemap, 84 : stack, sccl, cont } = args 85 : 86 : (* loop over the follow-set of a node *) 87 : fun loop [] (nodemap, stack, sccl) = 88 : let 89 : val nl = !node_low 90 : in 91 : if nl = node_pre then 92 : let 93 : fun grab (top :: stack, scc) = 94 : if Node.eq (top, node) then 95 : cont (nodemap, stack, 96 : component (top, scc) :: sccl) 97 : else 98 : grab (stack, top :: scc) 99 : | grab _ = raise SccBug 100 : in 101 : grab (stack, []) 102 : end 103 : else let 104 : val _ = 105 : (* propagate node_low up *) 106 : if nl < (!parent_low) then parent_low := nl else () 107 : in 108 : (* `return' *) 109 : cont (nodemap, stack, sccl) 110 : end 111 : end 112 : monnier 411 | loop (tn :: tnl) (nodemap as (npre, theMap), stack, sccl) = 113 : (case Map.find(theMap, tn) 114 : of SOME{ pre = tn_pre, low = tn_low } => let 115 : val tl = !tn_low 116 : in 117 : if tl < (!node_low) andalso 118 : List.exists (theNode tn) stack then 119 : node_low := tl 120 : else (); 121 : loop tnl (nodemap, stack, sccl) 122 : end 123 : | NONE =>let 124 : (* lookup failed -> tn is a new node *) 125 : val tn_pre = npre 126 : val tn_low = ref npre 127 : val npre = npre + 1 128 : val theMap = 129 : Map.insert (theMap, tn, 130 : { pre = tn_pre, low = tn_low }) 131 : val nodemap = (npre, theMap) 132 : in 133 : dfs { node = tn, node_pre = tn_pre, node_low = tn_low, 134 : parent_low = node_low, 135 : nodemap = nodemap, 136 : stack = tn :: stack, 137 : sccl = sccl, 138 : cont = loop tnl } 139 : end 140 : (*esac*)) 141 : monnier 245 in 142 : loop (follow node) (nodemap, stack, sccl) 143 : end 144 : 145 : val root_low = ref 0 146 : in 147 : dfs { node = root, node_pre = 0, node_low = root_low, 148 : parent_low = ref 0, (* dummy *) 149 : monnier 411 nodemap = (1, Map.insert (Map.empty, root, { pre = 0, low = root_low })), 150 : monnier 245 stack = [root], 151 : sccl = [], 152 : cont = fn (_, _, sccl) => sccl } 153 : end 154 : end 155 :

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