X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FOptimizationFuel.hs;h=175dcd09b18a4c602cb9531796d0f4b7abf89673;hb=2bb3a439c106935d97fae7f7a0b60c21493d1bef;hp=d9e83650176b749945480c4e4d15ae744d966f5c;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs index d9e8365..175dcd0 100644 --- a/compiler/cmm/OptimizationFuel.hs +++ b/compiler/cmm/OptimizationFuel.hs @@ -1,5 +1,11 @@ +-- | Optimisation fuel is used to control the amount of work the optimiser does. +-- +-- Every optimisation step consumes a certain amount of fuel and stops when +-- it runs out of fuel. This can be used e.g. to debug optimiser bugs: Run +-- the optimiser with varying amount of fuel to find out the exact number of +-- steps where a bug is introduced in the output. module OptimizationFuel - ( OptimizationFuel , canRewriteWithFuel, maybeRewriteWithFuel, oneLessFuel + ( OptimizationFuel, canRewriteWithFuel, maybeRewriteWithFuel, oneLessFuel , OptFuelState, initOptFuelState --, setTotalFuel , tankFilledTo, diffFuel , FuelConsumer @@ -17,7 +23,7 @@ import ZipCfg --import GHC.Exts (State#) import Panic import Data.IORef -import Monad +import Control.Monad import StaticFlags (opt_Fuel) import UniqSupply @@ -59,7 +65,7 @@ diffFuel (OptimizationFuel f) (OptimizationFuel f') = f - f' -- type OptimizationFuel = State# () -- would like this, but it won't work data OptimizationFuel = OptimizationFuel deriving Show -tankFilledTo _ = undefined -- should be impossible to evaluate +tankFilledTo _ = panic "tankFilledTo" -- should be impossible to evaluate -- realWorld# might come in handy, too... canRewriteWithFuel OptimizationFuel = True maybeRewriteWithFuel _ ma = ma @@ -128,7 +134,7 @@ fuelDecrementState new_optimizer old new s = optimizer = if diffFuel old new > 0 then new_optimizer else fs_lastpass s -- lGraphOfGraph is here because we need uniques to implement it. -lGraphOfGraph :: Graph m l -> Int -> FuelMonad (LGraph m l) -lGraphOfGraph (Graph tail blocks) args = +lGraphOfGraph :: Graph m l -> FuelMonad (LGraph m l) +lGraphOfGraph (Graph tail blocks) = do entry <- liftM BlockId $ getUniqueM - return $ LGraph entry args (insertBlock (Block entry Nothing tail) blocks) + return $ LGraph entry (insertBlock (Block entry tail) blocks)