[project @ 2000-10-12 11:47:25 by sewardj]
[ghc-hetmet.git] / ghc / compiler / utils / Digraph.lhs
index b904fff..f09d465 100644 (file)
@@ -36,9 +36,8 @@ module Digraph(
 
 import Util    ( sortLt )
 
--- GHC extensions
+-- Extensions
 import ST
-import MutableArray
 
 -- std interfaces
 import Maybe
@@ -119,11 +118,7 @@ mapT    :: (Vertex -> a -> b) -> Table a -> Table b
 mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
 
 buildG :: Bounds -> [Edge] -> Graph
-#ifdef REALLY_HASKELL_1_3
 buildG bounds edges = accumArray (flip (:)) [] bounds edges
-#else
-buildG bounds edges = accumArray (flip (:)) [] bounds [(,) k v | (k,v) <- edges]
-#endif
 
 transposeG  :: Graph -> Graph
 transposeG g = buildG (bounds g) (reverseE g)
@@ -154,7 +149,7 @@ graphFromEdges 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]
+    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 }
@@ -225,16 +220,16 @@ draw (Node x ts) = grp this (space (length this)) (stLoop ts)
 %************************************************************************
 
 \begin{code}
-type Set s    = MutableArray s Vertex Bool
+type Set s    = STArray s Vertex Bool
 
 mkEmpty      :: Bounds -> ST s (Set s)
-mkEmpty bnds  = newArray bnds False
+mkEmpty bnds  = newSTArray bnds False
 
 contains     :: Set s -> Vertex -> ST s Bool
-contains m v  = readArray m v
+contains m v  = readSTArray m v
 
 include      :: Set s -> Vertex -> ST s ()
-include m v   = writeArray m v True
+include m v   = writeSTArray m v True
 \end{code}
 
 \begin{code}
@@ -377,13 +372,13 @@ path g v w    = w `elem` (reachable g v)
 
 \begin{code}
 bcc :: Graph -> Forest [Vertex]
-bcc g = (concat . map bicomps . map (label g dnum)) forest
+bcc g = (concat . map bicomps . map (do_label g dnum)) forest
  where forest = dff g
        dnum   = preArr (bounds g) forest
 
-label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
-label g dnum (Node v ts) = Node (v,dnum!v,lv) us
- where us = map (label g dnum) ts
+do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
+do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us
+ where us = map (do_label g dnum) ts
        lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]
                      ++ [lu | Node (u,du,lu) xs <- us])