X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FOptimizationFuel.hs;h=f624c1c7b6c42c7719832842bc82fdd9cf03d9fe;hp=e1f1e3c39e5c8440169d763a347c61e1f8cd1500;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=889c084e943779e76d19f2ef5e970ff655f511eb

diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index e1f1e3c..f624c1c 100644
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -6,12 +6,12 @@
 -- 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, amountOfFuel, tankFilledTo, anyFuelLeft, oneLessFuel
+    ( OptimizationFuel, amountOfFuel, tankFilledTo, unlimitedFuel, anyFuelLeft, oneLessFuel
     , OptFuelState, initOptFuelState
     , FuelConsumer, FuelUsingMonad, FuelState
     , fuelGet, fuelSet, lastFuelPass, setFuelPass
     , fuelExhausted, fuelDec1, tryWithFuel
-    , runFuelIO, fuelConsumingPass
+    , runFuelIO, runInfiniteFuelIO, fuelConsumingPass
     , FuelUniqSM
     , liftUniq
     )
@@ -21,7 +21,7 @@ import Data.IORef
 import Control.Monad
 import StaticFlags (opt_Fuel)
 import UniqSupply
-import Panic ()
+import Panic
 
 import Compiler.Hoopl
 import Compiler.Hoopl.GHC (getFuel, setFuel)
@@ -49,8 +49,8 @@ amountOfFuel :: OptimizationFuel -> Int
 
 anyFuelLeft :: OptimizationFuel -> Bool
 oneLessFuel :: OptimizationFuel -> OptimizationFuel
+unlimitedFuel :: OptimizationFuel
 
-#ifdef DEBUG
 newtype OptimizationFuel = OptimizationFuel Int
   deriving Show
 
@@ -59,16 +59,7 @@ amountOfFuel (OptimizationFuel f) = f
 
 anyFuelLeft (OptimizationFuel f) = f > 0
 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
-#else
--- type OptimizationFuel = State# () -- would like this, but it won't work
-data OptimizationFuel = OptimizationFuel
-  deriving Show
-tankFilledTo _ = OptimizationFuel
-amountOfFuel _ = maxBound
-
-anyFuelLeft _ = True
-oneLessFuel _ = OptimizationFuel
-#endif
+unlimitedFuel = OptimizationFuel infiniteFuel
 
 data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass :: String }
 newtype FuelUniqSM a = FUSM { unFUSM :: FuelState -> UniqSM (a, FuelState) }
@@ -90,6 +81,16 @@ runFuelIO fs (FUSM f) =
        writeIORef (fuel_ref fs) fuel'
        return a
 
+-- ToDo: Do we need the pass_ref when we are doing infinite fueld
+-- transformations?
+runInfiniteFuelIO :: OptFuelState -> FuelUniqSM a -> IO a
+runInfiniteFuelIO fs (FUSM f) =
+    do pass <- readIORef (pass_ref fs)
+       u <- mkSplitUniqSupply 'u'
+       let (a, FuelState _ pass') = initUs_ u $ f (FuelState unlimitedFuel pass)
+       writeIORef (pass_ref fs) pass'
+       return a
+
 instance Monad FuelUniqSM where
   FUSM f >>= k = FUSM (\s -> f s >>= \(a, s') -> unFUSM (k a) s')
   return a     = FUSM (\s -> return (a, s))