X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FDigraph.lhs;h=0eff6da6980e6d87e24d3fb45c506325e61c1ed0;hb=59c796f8e77325d35f29ddd3e724bfa780466d40;hp=d8f6220658945fa5a24cb2acf846f7096a802563;hpb=dbc254c3dcd64761015a3d1c191ac742caafbf4c;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Digraph.lhs b/ghc/compiler/utils/Digraph.lhs index d8f6220..0eff6da 100644 --- a/ghc/compiler/utils/Digraph.lhs +++ b/ghc/compiler/utils/Digraph.lhs @@ -32,9 +32,7 @@ module Digraph( ------------------------------------------------------------------------------ -#define ARR_ELT (COMMA) - -import Util ( sortLt ) +import Util ( sortLe ) -- Extensions import MONAD_ST @@ -80,7 +78,8 @@ stronglyConnComp => [(node, key, [key])] -- The graph; its ok for the -- out-list to contain keys which arent -- a vertex key, they are ignored - -> [SCC node] + -> [SCC node] -- Returned in topologically sorted order + -- Later components depend on earlier ones, but not vice versa stronglyConnComp edges = map get_node (stronglyConnCompR edges) @@ -101,8 +100,8 @@ stronglyConnCompR [] = [] -- added to avoid creating empty array in graphFromEd stronglyConnCompR edges = map decode forest where - (graph, vertex_fn) = graphFromEdges edges - forest = scc graph + (graph, vertex_fn) = _scc_ "graphFromEdges" graphFromEdges edges + forest = _scc_ "Digraph.scc" scc graph decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v] | otherwise = AcyclicSCC (vertex_fn v) decode other = CyclicSCC (dec other []) @@ -164,14 +163,16 @@ graphFromEdges edges where max_v = length edges - 1 bounds = (0,max_v) :: (Vertex, Vertex) - sorted_edges = sortLt lt edges + sorted_edges = let + (_,k1,_) `le` (_,k2,_) = case k1 `compare` k2 of { GT -> False; other -> True } + in + sortLe le edges edges1 = zipWith (,) [0..] sorted_edges graph = array bounds [(,) v (mapMaybe key_vertex ks) | (,) v (_, _, ks) <- edges1] key_map = array bounds [(,) v k | (,) v (_, k, _ ) <- edges1] vertex_map = array bounds edges1 - (_,k1,_) `lt` (_,k2,_) = case k1 `compare` k2 of { LT -> True; other -> False } -- key_vertex :: key -> Maybe Vertex -- returns Nothing for non-interesting vertices @@ -307,9 +308,6 @@ preorder (Node a ts) = a : preorderF ts preorderF :: Forest a -> [a] preorderF ts = concat (map preorder ts) -preOrd :: Graph -> [Vertex] -preOrd = preorderF . dff - tabulate :: Bounds -> [Vertex] -> Table Int tabulate bnds vs = array bnds (zipWith (,) vs [1..]) @@ -363,12 +361,6 @@ scc g = dfs g (reverse (postOrd (transposeG g))) ------------------------------------------------------------ \begin{code} -tree :: Bounds -> Forest Vertex -> Graph -tree bnds ts = buildG bnds (concat (map flat ts)) - where - flat (Node v rs) = [ (v, w) | Node w us <- ts ] ++ - concat (map flat ts) - back :: Graph -> Table Int -> Graph back g post = mapT select g where select v ws = [ w | w <- ws, post!v < post!w ]