added monadic mapM_blocks. the fear, the fear...

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

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 789b401..970cdcb 100644 (file)
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -1,7 +1,8 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
 module DFMonad
-    ( Txlimit
+    ( 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
@@ -72,7 +73,7 @@ data DFAState f = DFAState { df_facts :: BlockEnv f
                            , df_facts_change :: ChangeFlag
                            }
 
-data DFTxState = DFTxState { df_txlimit :: Txlimit, df_lastpass :: String }
+data DFTxState = DFTxState { df_txlimit :: OptimizationFuel, df_lastpass :: String }
 
 data DFState f = DFState { df_uniqs :: UniqSupply
                          , df_rewritten :: ChangeFlag
@@ -96,7 +97,7 @@ liftTx (DFTx f) = DFM f'
     where f' _ s = let (a, txs) = f (df_txstate s)
                    in  (a, s {df_txstate = txs})
 
-newtype Txlimit = Txlimit Int
+newtype OptimizationFuel = OptimizationFuel Int
   deriving (Ord, Eq, Num, Show, Bounded)
 
 initDFAState :: DFAState f
@@ -108,7 +109,12 @@ 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
 
-runDFTx :: Txlimit -> DFTx a -> a  --- should only be called once per program!
+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>"
 
 lastTxPass :: DFTx String
@@ -125,11 +131,11 @@ txExhausted :: DFTx Bool
 txExhausted = DFTx f
     where f s = (df_txlimit s <= 0, s)
 
-txRemaining :: DFTx Txlimit
+txRemaining :: DFTx OptimizationFuel
 txRemaining = DFTx f
     where f s = (df_txlimit s, s)
 
-txDecrement :: String -> Txlimit -> Txlimit -> DFTx ()
+txDecrement :: String -> OptimizationFuel -> OptimizationFuel -> DFTx ()
 txDecrement optimizer old new = DFTx f
     where f s = ((), s { df_txlimit = lim s, df_lastpass = optimizer })
           lim s = if old == df_txlimit s then new
@@ -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
@@ -283,5 +289,5 @@ f4sep [] = fsep []
 f4sep (d:ds) = fsep (d : map (nest 4) ds)
 
 
-_I_am_abstract :: Int -> Txlimit
-_I_am_abstract = Txlimit -- prevents a warning about Txlimit being unused
+_I_am_abstract :: Int -> OptimizationFuel
+_I_am_abstract = OptimizationFuel -- prevents warning: OptimizationFuel unused