X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDFMonad.hs;h=0bce264de6fc510570bc9b2c6abaf6b08e86b708;hb=79d422b3a9e89f0d6dc3ad2383b2c8bd33b5a1d2;hp=3df5b681cfe810c10d2fa2723788be8dd98581d6;hpb=0d80489c9b9f2421f65d8dd86c1e50c6bb429715;p=ghc-hetmet.git diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs index 3df5b68..0bce264 100644 --- 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')