1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
--- ---------------------------------------------------------------------------- --- Computing strongly connected components --- --- Copyright (c) 2000 - 2003, Wolfgang Lux --- See LICENSE for the full license. --- --- The function `scc` computes the strongly connected components of a list --- of entities in two steps. First, the list is topologically sorted --- "downwards" using the *defines* relation. --- Then the resulting list is sorted "upwards" using the *uses* relation --- and partitioned into the connected components. Both relations --- are computed within this module using the bound and free names of each --- declaration. --- --- In order to avoid useless recomputations, the code in the module first --- decorates the declarations with their bound and free names and a --- unique number. The latter is only used to provide a trivial ordering --- so that the declarations can be used as set elements. --- --- @author Wolfgang Lux --- ---------------------------------------------------------------------------- module Data.SCC (scc) where import Data.Set.RBTree (empty, member, insert) data Node a b = Node Int [b] [b] a deriving Eq cmpNode :: Node a b -> Node a b -> Bool cmpNode n1 n2 = key n1 < key n2 key :: Node a b -> Int key (Node k _ _ _) = k bvs :: Node a b -> [b] bvs (Node _ bs _ _) = bs fvs :: Node a b -> [b] fvs (Node _ _ fs _) = fs node :: Node a b -> a node (Node _ _ _ n) = n --- Computes the strongly connected components of a list --- of entities. To be flexible, we distinguish the nodes and --- the entities defined in this node. --- --- @param defines - maps each node to the entities defined in this node --- @param uses - maps each node to the entities used in this node --- @param nodes - the list of nodes which should be sorted into --- strongly connected components --- @return the strongly connected components of the list of nodes scc :: (Eq a, Eq b) => (a -> [b]) -- ^ entities defined by node -> (a -> [b]) -- ^ entities used by node -> [a] -- ^ list of nodes -> [[a]] -- ^ strongly connected components scc bvs' fvs' = map (map node) . tsort' . tsort . zipWith wrap [0 ..] where wrap i n = Node i (bvs' n) (fvs' n) n tsort :: (Eq a, Eq b) => [Node a b] -> [Node a b] tsort xs = snd (dfs xs (empty cmpNode) []) where dfs [] marks stack = (marks, stack) dfs (x : xs') marks stack | x `member` marks = dfs xs' marks stack | otherwise = dfs xs' marks' (x : stack') where (marks', stack') = dfs (defs x) (x `insert` marks) stack defs x1 = filter (any (`elem` fvs x1) . bvs) xs tsort' :: (Eq a, Eq b) => [Node a b] -> [[Node a b]] tsort' xs = snd (dfs xs (empty cmpNode) []) where dfs [] marks stack = (marks, stack) dfs (x : xs') marks stack | x `member` marks = dfs xs' marks stack | otherwise = dfs xs' marks' ((x : concat stack') : stack) where (marks', stack') = dfs (uses x) (x `insert` marks) [] uses x1 = filter (any (`elem` bvs x1) . fvs) xs |