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