X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDFMonad.hs;h=970cdcb943ae6f7b36b8bcd249c80fe4232fd9cf;hb=6a347ffc34c0ded44c213e2a0217477f7b8196b9;hp=fc2fd45cd200d0da048b14c50460dc1f515106f6;hpb=fd8d04119e849f9c713d3e697228846d93c5ca69;p=ghc-hetmet.git diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs index fc2fd45..970cdcb 100644 --- a/compiler/cmm/DFMonad.hs +++ b/compiler/cmm/DFMonad.hs @@ -1,7 +1,8 @@ -{-# OPTIONS -Wall -fno-warn-name-shadowing #-} + module DFMonad ( OptimizationFuel , DFTx, runDFTx, lastTxPass, txDecrement, txRemaining, txExhausted + , functionalDFTx , DataflowLattice(..) , DataflowAnalysis @@ -24,7 +25,7 @@ import Maybes import PprCmm() import UniqFM import UniqSupply -import ZipCfg hiding (freshBlockId) +import ZipCfg import qualified ZipCfg as G import Outputable @@ -108,6 +109,11 @@ runDFA lattice (DFA f) = fst $ f lattice initDFAState -- XXX DFTx really needs to be in IO, so we can dump programs in -- intermediate states of optimization ---NR +functionalDFTx :: String -> (OptimizationFuel -> (a, OptimizationFuel)) -> DFTx a +functionalDFTx name pass = DFTx f + where f s = let (a, fuel) = pass (df_txlimit s) + in (a, DFTxState fuel name) + runDFTx :: OptimizationFuel -> DFTx a -> a --- should only be called once per program! runDFTx lim (DFTx f) = fst $ f $ DFTxState lim "" @@ -247,7 +253,7 @@ markGraphRewritten = DFM f where f _ s = ((), s {df_rewritten = SomeChange}) freshBlockId :: String -> DFM f BlockId -freshBlockId s = liftUSM $ G.freshBlockId s +freshBlockId _s = liftUSM $ getUniqueUs >>= return . BlockId liftUSM :: UniqSM a -> DFM f a liftUSM uc = DFM f