1{------------------------------------------------------------------------------ 2 DFS 3 4This module is a portable version of the ghc-specific `DFS.g.hs', which is 5itself a straightforward encoding of the Launchbury/King paper on linear graph 6algorithms. This module uses balanced binary trees instead of mutable arrays 7to implement the depth-first search so the complexity of the algorithms is 8n.log(n) instead of linear. 9 10The vertices of the graphs manipulated by these modules are labelled with the 11integers from 0 to n-1 where n is the number of vertices in the graph. 12 13The module's principle products are `mk_graph' for constructing a graph from an 14edge list, `t_close' for taking the transitive closure of a graph and `scc' 15for generating a list of strongly connected components; the components are 16listed in dependency order and each component takes the form of a `dfs tree' 17(see Launchberry and King). Thus if each edge (fid,fid') encodes the fact that 18function `fid' references function `fid'' in a program then `scc' performs a 19dependency analysis. 20 21Chris Dornan, 23-Jun-94, 2-Jul-96, 29-Aug-96, 29-Sep-97 22------------------------------------------------------------------------------} 23 24module DFS where 25 26import Set ( Set ) 27import qualified Set hiding ( Set ) 28 29import Data.Array ( (!), accumArray, listArray ) 30 31-- The result of a depth-first search of a graph is a list of trees, 32-- `GForrest'. `post_order' provides a post-order traversal of a forrest. 33 34type GForrest = [GTree] 35data GTree = GNode Int GForrest 36 37postorder:: GForrest -> [Int] 38postorder ts = po ts [] 39 where 40 po ts' l = foldr po_tree l ts' 41 42 po_tree (GNode a ts') l = po ts' (a:l) 43 44list_tree:: GTree -> [Int] 45list_tree t = l_t t [] 46 where 47 l_t (GNode x ts) l = foldr l_t (x:l) ts 48 49 50-- Graphs are represented by a pair of an integer, giving the number of nodes 51-- in the graph, and function mapping each vertex (0..n-1, n=size of graph) to 52-- its neighbouring nodes. `mk_graph' takes a size and an edge list and 53-- constructs a graph. 54 55type Graph = (Int,Int->[Int]) 56type Edge = (Int,Int) 57 58mk_graph:: Int -> [Edge] -> Graph 59mk_graph sz es = (sz,\v->ar!v) 60 where 61 ar = accumArray (flip (:)) [] (0,sz-1) [(v,v')| (v,v')<-es] 62 63vertices:: Graph -> [Int] 64vertices (sz,_) = [0..sz-1] 65 66out:: Graph -> Int -> [Int] 67out (_,f) = f 68 69edges:: Graph -> [Edge] 70edges g = [(v,v')| v<-vertices g, v'<-out g v] 71 72rev_edges:: Graph -> [Edge] 73rev_edges g = [(v',v)| v<-vertices g, v'<-out g v] 74 75reverse_graph:: Graph -> Graph 76reverse_graph g@(sz,_) = mk_graph sz (rev_edges g) 77 78 79-- `t_close' takes the transitive closure of a graph; `scc' returns the stronly 80-- connected components of the graph and `top_sort' topologically sorts the 81-- graph. Note that the array is given one more element in order to avoid 82-- problems with empty arrays. 83 84t_close:: Graph -> Graph 85t_close g@(sz,_) = (sz,\v->ar!v) 86 where 87 ar = listArray (0,sz) ([postorder(dff' [v] g)| v<-vertices g]++[und]) 88 und = error "t_close" 89 90scc:: Graph -> GForrest 91scc g = dff' (reverse (top_sort (reverse_graph g))) g 92 93top_sort:: Graph -> [Int] 94top_sort = postorder . dff 95 96 97-- `dff' computes the depth-first forrest. It works by unrolling the 98-- potentially infinite tree from each of the vertices with `generate_g' and 99-- then pruning out the duplicates. 100 101dff:: Graph -> GForrest 102dff g = dff' (vertices g) g 103 104dff':: [Int] -> Graph -> GForrest 105dff' vs (_bs, f) = prune (map (generate_g f) vs) 106 107generate_g:: (Int->[Int]) -> Int -> GTree 108generate_g f v = GNode v (map (generate_g f) (f v)) 109 110prune:: GForrest -> GForrest 111prune ts = snd(chop(empty_int,ts)) 112 where 113 empty_int:: Set Int 114 empty_int = Set.empty 115 116chop:: (Set Int,GForrest) -> (Set Int,GForrest) 117chop p@(_, []) = p 118chop (vstd,GNode v ts:us) = 119 if v `Set.member` vstd 120 then chop (vstd,us) 121 else let vstd1 = Set.insert v vstd 122 (vstd2,ts') = chop (vstd1,ts) 123 (vstd3,us') = chop (vstd2,us) 124 in 125 (vstd3,GNode v ts' : us') 126 127 128{-- Some simple test functions 129 130test:: Graph Char 131test = mk_graph (char_bds ('a','h')) (mk_pairs "eefggfgegdhfhged") 132 where 133 mk_pairs [] = [] 134 mk_pairs (a:b:l) = (a,b):mk_pairs l 135 136-} 137