X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDFMonad.hs;h=970cdcb943ae6f7b36b8bcd249c80fe4232fd9cf;hb=4b0d76295acb46696d297192c9178b460d2472b8;hp=789b4010b0b047b99048d7e01d55173fd11d64fd;hpb=8b7eaa404043294bd4cb4a0322ac1f7115bad6a0;p=ghc-hetmet.git diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs index 789b401..970cdcb 100644 --- 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 "" 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