Big collection of patches for the new codegen branch.

[ghc-hetmet.git] / compiler / cmm / DFMonad.hs

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 3df5b68..0bce264 100644 (file)
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -7,7 +7,6 @@ module DFMonad
 
     , DFM, runDFM, liftToDFM
     , markGraphRewritten, graphWasRewritten
-    , freshBlockId
     , module OptimizationFuel
     )
 where
@@ -20,7 +19,6 @@ import OptimizationFuel
 import Control.Monad
 import Maybes
 import Outputable
-import UniqFM
 import UniqSupply
 
 {-
@@ -75,14 +73,14 @@ type DFM fact a = DFM' FuelMonad fact a
 
 runDFM :: Monad m => DataflowLattice f -> DFM' m f a -> m a
 runDFM lattice (DFM' f) =
-  (f lattice $ DFState NoChange emptyBlockEnv (fact_bot lattice)[] NoChange)
+  (f lattice $ DFState NoChange emptyBlockEnv (fact_bot lattice) [] NoChange)
   >>= return . fst
 
 class DataflowAnalysis m where
   markFactsUnchanged :: m f ()   -- ^ Useful for starting a new iteration
   factsStatus :: m f ChangeFlag
   subAnalysis :: m f a -> m f a  -- ^ Do a new analysis and then throw away
-                                 -- *all* the related state.
+                                 -- /all/ the related state.
 
   getFact :: BlockId -> m f f
   setFact :: Outputable f => BlockId -> f -> m f ()
@@ -154,7 +152,7 @@ instance Monad m => DataflowAnalysis (DFM' m) where
   botFact = DFM' f
     where f lattice s = return (fact_bot lattice, s)
   forgetFact id = DFM' f 
-    where f _ s = return ((), s { df_facts = delFromUFM (df_facts s) id })
+    where f _ s = return ((), s { df_facts = delFromBlockEnv (df_facts s) id })
   addLastOutFact pair = DFM' f
     where f _ s = return ((), s { df_last_outs = pair : df_last_outs s })
   bareLastOutFacts = DFM' f
@@ -176,7 +174,7 @@ instance Monad m => DataflowAnalysis (DFM' m) where
                                     text "env is", pprFacts facts]) 
                   ; setFact id a }
          }
-    where pprFacts env = vcat (map pprFact (ufmToList env))
+    where pprFacts env = vcat (map pprFact (blockEnvToList env))
           pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
 
   lattice = DFM' f
@@ -194,9 +192,6 @@ graphWasRewritten :: DFM f ChangeFlag
 graphWasRewritten = DFM' f
     where f _ s = return (df_rewritten s, s)
                     
-freshBlockId :: String -> DFM f BlockId
-freshBlockId _s = getUniqueM >>= return . BlockId
-
 instance Monad m => Monad (DFM' m f) where
   DFM' f >>= k = DFM' (\l s -> do (a, s') <- f l s
                                   let DFM' f' = k a in f' l s')