X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FDigraph.lhs;h=6d1d8d4639b5bf218aa074150853fa133d601111;hb=1d47f08d196252b4ee5f4d5b5af2fb4945720762;hp=f4f2b7e3663887fceb4cd4dce4f733fc590d98ec;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs
index f4f2b7e..6d1d8d4 100644
--- a/compiler/utils/Digraph.lhs
+++ b/compiler/utils/Digraph.lhs
@@ -3,13 +3,6 @@
 %
 
 \begin{code}
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
-
 module Digraph(
 
         -- At present the only one with a "nice" external interface
@@ -31,7 +24,7 @@ module Digraph(
         bcc
     ) where
 
-# include "HsVersions.h"
+#include "HsVersions.h"
 
 ------------------------------------------------------------------------------
 -- A version of the graph algorithms described in:
@@ -54,7 +47,7 @@ import Data.Maybe
 import Data.Array
 import Data.List
 
-#if __GLASGOW_HASKELL__ > 604
+#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ > 604
 import Data.Array.ST
 #else
 import Data.Array.ST  hiding ( indices, bounds )
@@ -75,6 +68,7 @@ data SCC vertex = AcyclicSCC vertex
 flattenSCCs :: [SCC a] -> [a]
 flattenSCCs = concatMap flattenSCC
 
+flattenSCC :: SCC a -> [a]
 flattenSCC (AcyclicSCC v) = [v]
 flattenSCC (CyclicSCC vs) = vs
 
@@ -83,6 +77,16 @@ instance Outputable a => Outputable (SCC a) where
    ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
 \end{code}
 
+Note [Nodes, keys, vertices]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * A 'node' is a big blob of client-stuff
+
+ * Each 'node' has a unique (client) 'key', but the latter 
+	is in Ord and has fast comparison
+
+ * Digraph then maps each 'key' to a Vertex (Int) which is
+  	arranged densely in 0.n
+
 \begin{code}
 stronglyConnComp
         :: Ord key
@@ -157,7 +161,7 @@ reverseE g   = [ (w, v) | (v, w) <- edges g ]
 
 outdegree :: Graph -> Table Int
 outdegree  = mapT numEdges
-             where numEdges v ws = length ws
+             where numEdges _ ws = length ws
 
 indegree :: Graph -> Table Int
 indegree  = outdegree . transposeG
@@ -182,7 +186,7 @@ graphFromEdges' edges
     max_v           = length edges - 1
     bounds          = (0,max_v) :: (Vertex, Vertex)
     sorted_edges    = let
-                         (_,k1,_) `le` (_,k2,_) = case k1 `compare` k2 of { GT -> False; other -> True }
+                         (_,k1,_) `le` (_,k2,_) = (k1 `compare` k2) /= GT
                       in
                         sortLe le edges
     edges1          = zipWith (,) [0..] sorted_edges
@@ -224,7 +228,7 @@ mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts)
 
 \begin{code}
 instance Show a => Show (Tree a) where
-  showsPrec p t s = showTree t ++ s
+  showsPrec _ t s = showTree t ++ s
 
 showTree :: Show a => Tree a -> String
 showTree  = drawTree . mapTree show
@@ -235,6 +239,7 @@ showForest  = unlines . map showTree
 drawTree        :: Tree String -> String
 drawTree         = unlines . draw
 
+draw :: Tree String -> [String]
 draw (Node x ts) = grp this (space (length this)) (stLoop ts)
  where this          = s1 ++ x ++ " "
 
@@ -244,6 +249,7 @@ draw (Node x ts) = grp this (space (length this)) (stLoop ts)
        stLoop [t]    = grp s2 "  " (draw t)
        stLoop (t:ts) = grp s3 s4 (draw t) ++ [s4] ++ rsLoop ts
 
+       rsLoop []     = []
        rsLoop [t]    = grp s5 "  " (draw t)
        rsLoop (t:ts) = grp s6 s4 (draw t) ++ [s4] ++ rsLoop ts
 
@@ -287,7 +293,7 @@ prune bnds ts = runST (mkEmpty bnds  >>= \m ->
                        chop m ts)
 
 chop         :: Set s -> Forest Vertex -> ST s (Forest Vertex)
-chop m []     = return []
+chop _ []     = return []
 chop m (Node v ts : us)
               = contains m v >>= \visited ->
                 if visited then
@@ -311,7 +317,7 @@ chop m (Node v ts : us)
 ------------------------------------------------------------
 
 \begin{code}
---preorder            :: Tree a -> [a]
+preorder            :: Tree a -> [a]
 preorder (Node a ts) = a : preorderF ts
 
 preorderF           :: Forest a -> [a]
@@ -411,16 +417,16 @@ 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])
+                     ++ [lu | Node (_,_,lu) _ <- us])
 
 bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
-bicomps (Node (v,dv,lv) ts)
-      = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]
+bicomps (Node (v,_,_) ts)
+      = [ Node (v:vs) us | (_,Node vs us) <- map collect ts]
 
 collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])
 collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)
  where collected = map collect ts
-       vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]
+       vs = concat [ ws | (lw, Node ws _)  <- collected, lw<dv]
        cs = concat [ if lw<dv then us else [Node (v:ws) us]
                         | (lw, Node ws us) <- collected ]
 \end{code}