ghc/compiler/utils/Digraph.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[Digraph]{An implementation of directed graphs}
   5
   6 \begin{code}
   7 module Digraph (
   8          stronglyConnComp,
   9 --OLD:   whichCycle, -- MOVED: isCyclic,
  10          topologicalSort,
  11          dfs, -- deforester
  12          MaybeErr
  13     ) where
  14
  15 import Maybes           ( MaybeErr(..) )
  16 import Util
  17 \end{code}
  18
  19 This module implements at least part of an abstract data type for
  20 directed graphs.  The part implemented is what we need for doing
  21 dependency analyses.
  22
  23 >type Edge  vertex = (vertex, vertex)
  24 >type Cycle vertex = [vertex]
  25
  26 %************************************************************************
  27 %*                                                                      *
  28 %*      Strongly connected components                                   *
  29 %*                                                                      *
  30 %************************************************************************
  31
  32 John Launchbury provided the basic code for doing strongly-connected
  33 components.
  34
  35 The result is a list of cycles (each of which is a list of vertices),
  36 and these cycles are topologically sorted, so that if there is an edge from
  37 cycle A to cycle B, then A occurs after B in the result list.
  38
  39 \begin{code}
  40 stronglyConnComp :: (vertex->vertex->Bool) -> [Edge vertex] -> [vertex] -> [[vertex]]
  41
  42 stronglyConnComp eq edges vertices
  43   = snd (span_tree (new_range reversed_edges)
  44                     ([],[])
  45                    ( snd (dfs (new_range edges) ([],[]) vertices) )
  46         )
  47   where
  48     reversed_edges = map swap edges
  49
  50     swap (x,y) = (y, x)
  51
  52     -- new_range :: Eq v => [Edge v] -> v -> [v]
  53
  54     new_range    []       w = []
  55     new_range ((x,y):xys) w
  56          = if x `eq` w
  57            then (y : (new_range xys w))
  58            else (new_range xys w)
  59
  60     elem x []     = False
  61     elem x (y:ys) = x `eq` y || x `elem` ys
  62
  63 {-  span_tree :: Eq v => (v -> [v])
  64                        -> ([v], [[v]])
  65                        -> [v]
  66                        -> ([v], [[v]])
  67 -}
  68     span_tree r (vs,ns) []   = (vs,ns)
  69     span_tree r (vs,ns) (x:xs)
  70          | x `elem` vs = span_tree r (vs,ns) xs
  71          | True        = case (dfs r (x:vs,[]) (r x)) of { (vs',ns') ->
  72                          span_tree r (vs',(x:ns'):ns) xs }
  73
  74 {-  dfs :: Eq v => (v -> [v])
  75                  -> ([v], [v])
  76                  -> [v]
  77                  -> ([v], [v])
  78 -}
  79     dfs r (vs,ns)   []   = (vs,ns)
  80     dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
  81                          | True        = case (dfs r (x:vs,[]) (r x)) of { (vs',ns') ->
  82                                          dfs r (vs',(x:ns')++ns) xs }
  83 \end{code}
  84
  85 \begin{code}
  86 dfs :: (v -> v -> Bool)
  87     -> (v -> [v])
  88     -> ([v], [v])
  89     -> [v]
  90     -> ([v], [v])
  91
  92 dfs eq r (vs,ns)   []   = (vs,ns)
  93 dfs eq r (vs,ns) (x:xs)
  94         | any (eq x) vs = dfs eq r (vs,ns) xs
  95         | True          = case (dfs eq r (x:vs,[]) (r x)) of
  96                                 (vs',ns') -> dfs eq r (vs',(x:ns')++ns) xs
  97
  98 \end{code}
  99
 100
 101 @isCyclic@ expects to be applied to an element of the result of a
 102 stronglyConnComp; it tells whether such an element is a cycle.  The
 103 answer is True if it is not a singleton, of course, but if it is a
 104 singleton we have to look up in the edges to see if it refers to
 105 itself.
 106
 107 \begin{code}
 108 {- MOVED TO POINT OF SINGLE USE: RenameBinds4 (WDP 95/02)
 109
 110 isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
 111
 112 isCyclic edges [] = panic "isCyclic: empty component"
 113 isCyclic edges [v] = (v,v) `is_elem` edges where { is_elem = isIn "isCyclic" }
 114 isCyclic edges vs = True
 115 -}
 116 \end{code}
 117
 118 OLD: The following @whichCycle@ should be called only when the given
 119 @vertex@ is known to be in one of the cycles. This isn't difficult to
 120 achieve if the call follows the creation of the list of components by
 121 @cycles@ (NB: strictness analyser) with all vertices of interest in
 122 them.
 123
 124 >{- UNUSED:
 125 >whichCycle :: Eq vertex => [Cycle vertex] -> vertex -> (Cycle vertex)
 126 >whichCycle vss v = head [vs | vs <-vss, v `is_elem` vs] where { is_elem = isIn "whichCycle" }
 127 >-}
 128
 129 %************************************************************************
 130 %*                                                                      *
 131 %*      Topological sort                                                *
 132 %*                                                                      *
 133 %************************************************************************
 134
 135 Topological sort fails if it finds any cycles, returning the offending cycles.
 136
 137 If it succeeds, the result is a list of vertices, such that if there is
 138 an edge from vertex A to vertex B then A occurs after B in the result list.
 139
 140 \begin{code}
 141 topologicalSort :: (vertex->vertex->Bool) -> [Edge vertex] -> [vertex]
 142         -> MaybeErr [vertex]    -- Success: the sorted list
 143                     [[vertex]]  -- Failure: the cycles
 144
 145 topologicalSort eq edges vertices
 146   = case (stronglyConnComp eq edges vertices) of { sccs ->
 147     case (partition (is_cyclic edges) sccs)   of { (cycles, singletons) ->
 148     if null cycles
 149     then Succeeded [ v | [v] <- singletons ]
 150     else Failed cycles
 151     }}
 152   where
 153     is_cyclic es []  = panic "is_cyclic: empty component"
 154     is_cyclic es [v] = (v,v) `elem` es
 155     is_cyclic es vs  = True
 156
 157     elem (x,y)   []         = False
 158     elem z@(x,y) ((a,b):cs) = (x `eq` a && y `eq` b) || z `elem` cs
 159 \end{code}