add another way to run in the fuel monad (this is a mess right now)

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

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 0365cbb..970cdcb 100644 (file)
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -2,6 +2,7 @@
 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 "<none>"
 
@@ -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