Remove "fuel", adapt to Hoopl changes, fix warnings

27 files changed, 210 insertions, 394 deletions

diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs
index d5a8e045bf..4aedcb7074 100644
--- a/compiler/cmm/BlockId.hs
+++ b/compiler/cmm/BlockId.hs
@@ -15,7 +15,7 @@ import Outputable
 import Unique
 
 import Compiler.Hoopl as Hoopl hiding (Unique)
-import Compiler.Hoopl.GHC (uniqueToInt, uniqueToLbl, lblToUnique)
+import Compiler.Hoopl.Internals (uniqueToLbl)
 
 ----------------------------------------------------------------
 --- Block Ids, their environments, and their sets
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index d70fd8c835..1c77409e49 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -32,9 +32,9 @@ module Cmm (
 import CLabel
 import BlockId
 import CmmNode
-import OptimizationFuel as F
 import SMRep
 import CmmExpr
+import UniqSupply
 import Compiler.Hoopl
 
 import Data.Word        ( Word8 )
@@ -93,9 +93,9 @@ data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
 type CmmBlock = Block CmmNode C C
 
 type CmmReplGraph e x = GenCmmReplGraph CmmNode e x
-type GenCmmReplGraph n e x = FuelUniqSM (Maybe (Graph n e x))
-type CmmFwdRewrite f = FwdRewrite FuelUniqSM CmmNode f
-type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f
+type GenCmmReplGraph n e x = UniqSM (Maybe (Graph n e x))
+type CmmFwdRewrite f = FwdRewrite UniqSM CmmNode f
+type CmmBwdRewrite f = BwdRewrite UniqSM CmmNode f
 
 -----------------------------------------------------------------------------
 --     Info Tables
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index cd618bd99c..ebe755219b 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -38,7 +38,6 @@ import IdInfo
 import Data.List
 import Maybes
 import Name
-import OptimizationFuel
 import Outputable
 import SMRep
 import UniqSupply
@@ -149,7 +148,7 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
 -- we make sure they're all close enough to the bottom of the table that the
 -- bitmap will be able to cover all of them.
 buildSRTs :: TopSRT -> Map CLabel CAFSet -> CAFSet ->
-             FuelUniqSM (TopSRT, Maybe CmmDecl, C_SRT)
+             UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
 buildSRTs topSRT topCAFMap cafs =
   do let liftCAF lbl z = -- get CAFs for functions without static closures
            case Map.lookup lbl topCAFMap of Just cafs -> z `Set.union` cafs
@@ -192,7 +191,7 @@ buildSRTs topSRT topCAFMap cafs =
 -- Construct an SRT bitmap.
 -- Adapted from simpleStg/SRT.lhs, which expects Id's.
 procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] ->
-                FuelUniqSM (Maybe CmmDecl, C_SRT)
+                UniqSM (Maybe CmmDecl, C_SRT)
 procpointSRT _ _ [] =
  return (Nothing, NoC_SRT)
 procpointSRT top_srt top_table entries =
@@ -210,7 +209,7 @@ maxBmpSize :: Int
 maxBmpSize = widthInBits wordWidth `div` 2
 
 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
-to_SRT :: CLabel -> Int -> Int -> Bitmap -> FuelUniqSM (Maybe CmmDecl, C_SRT)
+to_SRT :: CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
 to_SRT top_srt off len bmp
   | len > maxBmpSize || bmp == [fromIntegral srt_escape]
   = do id <- getUniqueM
@@ -276,12 +275,12 @@ bundleCAFs _ t = (Set.empty, t)
 
 -- Construct the SRTs for the given procedure.
 setInfoTableSRT :: Map CLabel CAFSet -> TopSRT -> (CAFSet, CmmDecl) ->
-                   FuelUniqSM (TopSRT, [CmmDecl])
+                   UniqSM (TopSRT, [CmmDecl])
 setInfoTableSRT topCAFMap topSRT (cafs, t) =
   setSRT cafs topCAFMap topSRT t
 
 setSRT :: CAFSet -> Map CLabel CAFSet -> TopSRT ->
-          CmmDecl -> FuelUniqSM (TopSRT, [CmmDecl])
+          CmmDecl -> UniqSM (TopSRT, [CmmDecl])
 setSRT cafs topCAFMap topSRT t =
   do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap cafs
      let t' = updInfo id (const srt) t
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index d3d9ba4b41..484e89cd9b 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -53,7 +53,6 @@ assignArgumentsPos conv arg_ty reps = assignments
                ([_], PrimOpReturn)     -> allRegs
                (_,   PrimOpReturn)     -> getRegsWithNode
                (_,   Slow)             -> noRegs
-               _ -> pprPanic "Unknown calling convention" (ppr conv)
       -- The calling conventions first assign arguments to registers,
       -- then switch to the stack when we first run out of registers
       -- (even if there are still available registers for args of a different type).
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index 4df7304acf..eafa2a00f3 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -20,7 +20,6 @@ import Hoopl hiding (ChangeFlag)
 import Data.Bits
 import qualified Data.List as List
 import Data.Word
-import FastString
 import Outputable
 import UniqFM
 
@@ -95,7 +94,7 @@ hash_block block =
         hash_lst m h = hash_node m + h `shiftL` 1
 
         hash_node :: CmmNode O x -> Word32
-        hash_node (CmmComment (FastString u _ _ _ _)) = 0 -- don't care
+        hash_node (CmmComment _) = 0 -- don't care
         hash_node (CmmAssign r e) = hash_reg r + hash_e e
         hash_node (CmmStore e e') = hash_e e + hash_e e'
         hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as
@@ -148,7 +147,7 @@ lookupBid subst bid = case mapLookup bid subst of
 --
 eqMiddleWith :: (BlockId -> BlockId -> Bool)
              -> CmmNode O O -> CmmNode O O -> Bool
-eqMiddleWith eqBid (CmmComment _) (CmmComment _) = True
+eqMiddleWith _ (CmmComment _) (CmmComment _) = True
 eqMiddleWith eqBid (CmmAssign r1 e1) (CmmAssign r2 e2)
   = r1 == r2 && eqExprWith eqBid e1 e2
 eqMiddleWith eqBid (CmmStore l1 r1) (CmmStore l2 r2)
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 36e7b8ec62..3fabf33f97 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -97,7 +97,7 @@ blockConcat g@CmmGraph { g_entry = entry_id }
      maybe_concat :: CmmBlock
                   -> (BlockEnv CmmBlock, BlockEnv BlockId)
                   -> (BlockEnv CmmBlock, BlockEnv BlockId)
-     maybe_concat block unchanged@(blocks, shortcut_map)
+     maybe_concat block (blocks, shortcut_map)
         | CmmBranch b' <- last
         , Just blk' <- mapLookup b' blocks
         , shouldConcatWith b' blk'
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 939d4b7ca9..646ecb5c67 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -32,7 +32,6 @@ import BlockId
 import CLabel
 import Unique
 
-import Data.Map (Map)
 import Data.Set (Set)
 import qualified Data.Set as Set
 
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 573ce0eba0..f0dce4a6a1 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -17,7 +17,6 @@ import CmmLive
 import CmmProcPoint
 import SMRep
 import Hoopl hiding ((<*>), mkLast, mkMiddle)
-import OptimizationFuel
 import Constants
 import UniqSupply
 import Maybes
@@ -105,7 +104,7 @@ instance Outputable StackMap where
 
 
 cmmLayoutStack :: ProcPointSet -> ByteOff -> CmmGraph
-               -> FuelUniqSM (CmmGraph, BlockEnv StackMap)
+               -> UniqSM (CmmGraph, BlockEnv StackMap)
 cmmLayoutStack procpoints entry_args
                graph0@(CmmGraph { g_entry = entry })
   = do
@@ -114,12 +113,12 @@ cmmLayoutStack procpoints entry_args
     pprTrace "liveness" (ppr liveness) $ return ()
     let blocks = postorderDfs graph
 
-    (final_stackmaps, final_high_sp, new_blocks) <- liftUniq $
+    (final_stackmaps, final_high_sp, new_blocks) <-
           mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) ->
             layout procpoints liveness entry entry_args
                    rec_stackmaps rec_high_sp blocks
 
-    new_blocks' <- liftUniq $ mapM lowerSafeForeignCall new_blocks
+    new_blocks' <- mapM lowerSafeForeignCall new_blocks
 
     pprTrace ("Sp HWM") (ppr final_high_sp) $
        return (ofBlockList entry new_blocks', final_stackmaps)
@@ -248,7 +247,7 @@ collectContInfo blocks
 -- Updating the StackMap from middle nodes
 
 -- Look for loads from stack slots, and update the StackMap.  This is
--- purelyu for optimisation reasons, so that we can avoid saving a
+-- purely for optimisation reasons, so that we can avoid saving a
 -- variable back to a different stack slot if it is already on the
 -- stack.
 --
@@ -361,6 +360,7 @@ handleLastNode procpoints liveness cont_info stackmaps
            = setupStackFrame lbl liveness cml_ret_off cml_ret_args stack0
 
 
+     -- For other last nodes (branches), if any of the targets is a
      -- proc point, we have to set up the stack to match what the proc
      -- point is expecting.
      --
@@ -701,7 +701,7 @@ manifestSp stackmaps stack0 sp0 sp_high
 
     final_block   = blockJoin first final_middle final_last
 
-    fixup_blocks' = map (blockMapNodes3 (id, adj_post_sp, id)) fixup_blocks
+    fixup_blocks' = map (mapBlock3' (id, adj_post_sp, id)) fixup_blocks
 
 
 getAreaOff :: BlockEnv StackMap -> (Area -> StackLoc)
@@ -982,7 +982,7 @@ stackSlotRegs sm = eltsUFM (sm_regs sm)
 -- *but*, that will invalidate the liveness analysis, and we'll have
 -- to re-do it.
 
-cmmSink :: CmmGraph -> FuelUniqSM CmmGraph
+cmmSink :: CmmGraph -> UniqSM CmmGraph
 cmmSink graph = do
   let liveness = cmmLiveness graph
   return $ cmmSink' liveness graph
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index fd0659b761..2e24dd7f82 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -16,7 +16,6 @@ import CmmUtils
 import PprCmm ()
 import BlockId
 import FastString
-import CLabel
 import Outputable
 import Constants
 
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index ac9c38b448..f0163fefc4 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -11,11 +11,10 @@ module CmmLive
     )
 where
 
+import UniqSupply
 import BlockId
 import Cmm
 import CmmUtils
-import Control.Monad
-import OptimizationFuel
 import PprCmmExpr ()
 
 import Hoopl
@@ -81,7 +80,7 @@ xferLive = mkBTransfer3 fst mid lst
 -- Removing assignments to dead variables
 -----------------------------------------------------------------------------
 
-removeDeadAssignments :: CmmGraph -> FuelUniqSM (CmmGraph, BlockEnv CmmLive)
+removeDeadAssignments :: CmmGraph -> UniqSM (CmmGraph, BlockEnv CmmLive)
 removeDeadAssignments g =
    dataflowPassBwd g [] $ analRewBwd liveLattice xferLive rewrites
    where rewrites = mkBRewrite3 nothing middle nothing
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index cd46794580..9e75387436 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -400,5 +400,5 @@ mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C
 mapSuccessors f (CmmBranch bid)        = CmmBranch (f bid)
 mapSuccessors f (CmmCondBranch p y n)  = CmmCondBranch p (f y) (f n)
 mapSuccessors f (CmmSwitch e arms)     = CmmSwitch e (map (fmap f) arms)
-mapSuccessors f n = n
+mapSuccessors _ n = n
 
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 296204bda3..bb8d5b2f22 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -16,9 +16,9 @@ import CmmBuildInfoTables
 import CmmCommonBlockElim
 import CmmProcPoint
 import CmmContFlowOpt
-import OptimizationFuel
 import CmmLayoutStack
 
+import UniqSupply
 import DynFlags
 import ErrUtils
 import HscTypes
@@ -65,7 +65,7 @@ cmmPipeline hsc_env topSRT prog =
      let topCAFEnv = {-# SCC "topCAFEnv" #-} mkTopCAFInfo (concat cafEnvs)
 
      -- folding over the groups
-     (topSRT, tops) <- {-# SCC "toTops" #-} foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
+     (topSRT, tops) <- {-# SCC "toTops" #-} foldM (toTops topCAFEnv) (topSRT, []) tops
 
      let cmms :: CmmGroup
          cmms = reverse (concat tops)
@@ -101,17 +101,17 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        ----------- Proc points -------------------
        let callPPs = {-# SCC "callProcPoints" #-} callProcPoints g
-       procPoints <- {-# SCC "minimalProcPointSet" #-} run $
+       procPoints <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
                      minimalProcPointSet (targetPlatform dflags) callPPs g
 
        ----------- Layout the stack and manifest Sp ---------------
        -- (also does: removeDeadAssignments, and lowerSafeForeignCalls)
        (g, stackmaps) <- {-# SCC "layoutStack" #-}
-                         run $ cmmLayoutStack procPoints entry_off g
+                         runUniqSM $ cmmLayoutStack procPoints entry_off g
        dump Opt_D_dump_cmmz_sp "Layout Stack" g
 
-       g <- {-# SCC "sink" #-} run $ cmmSink g
-       dump Opt_D_dump_cmmz_rewrite "Sink assignments" g
+--       g <- {-# SCC "sink" #-} runUniqSM $ cmmSink g
+--       dump Opt_D_dump_cmmz_rewrite "Sink assignments" g
 
 --       ----------- Sink and inline assignments -------------------
 --       g <- {-# SCC "rewriteAssignments" #-} runOptimization $
@@ -119,10 +119,10 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 --       dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
 
        ------------- Split into separate procedures ------------
-       procPointMap  <- {-# SCC "procPointAnalysis" #-} run $
+       procPointMap  <- {-# SCC "procPointAnalysis" #-} runUniqSM $
                         procPointAnalysis procPoints g
        dumpWith dflags Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
-       gs <- {-# SCC "splitAtProcPoints" #-} run $
+       gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
              splitAtProcPoints l callPPs procPoints procPointMap (CmmProc h l g)
        dumps Opt_D_dump_cmmz_split "Post splitting" gs
 
@@ -156,8 +156,10 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
         dumps flag name
            = mapM_ (dumpWith dflags flag name)
 
-        -- Runs a required transformation/analysis
-        run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
+runUniqSM :: UniqSM a -> IO a
+runUniqSM m = do
+  us <- mkSplitUniqSupply 'u'
+  return (initUs_ us m)
 
 
 dumpGraph :: DynFlags -> DynFlag -> String -> CmmGraph -> IO ()
@@ -183,11 +185,11 @@ dumpWith dflags flag txt g = do
 -- This probably belongs in CmmBuildInfoTables?
 -- We're just finishing the job here: once we know what CAFs are defined
 -- in non-static closures, we can build the SRTs.
-toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmDecl]])
-                 -> [(CAFSet, CmmDecl)] -> IO (TopSRT, [[CmmDecl]])
-toTops hsc_env topCAFEnv (topSRT, tops) gs =
+toTops :: Map CLabel CAFSet -> (TopSRT, [[CmmDecl]])
+       -> [(CAFSet, CmmDecl)] -> IO (TopSRT, [[CmmDecl]])
+toTops topCAFEnv (topSRT, tops) gs =
   do let setSRT (topSRT, rst) g =
            do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g
               return (topSRT, gs : rst)
-     (topSRT, gs') <- runFuelIO (hsc_OptFuel hsc_env) $ foldM setSRT (topSRT, []) gs
+     (topSRT, gs') <- runUniqSM $ foldM setSRT (topSRT, []) gs
      return (topSRT, concat gs' : tops)
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 8dda51b9b7..6eb92666af 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -13,19 +13,14 @@ import Prelude hiding (last, unzip, succ, zip)
 import BlockId
 import CLabel
 import Cmm
+import PprCmm ()
 import CmmUtils
-import CmmContFlowOpt
 import CmmInfo
-import CmmLive
-import Constants
 import Data.List (sortBy)
 import Maybes
-import MkGraph
 import Control.Monad
-import OptimizationFuel
 import Outputable
 import Platform
-import UniqSet
 import UniqSupply
 
 import Hoopl
@@ -106,7 +101,7 @@ instance Outputable Status where
 --------------------------------------------------
 -- Proc point analysis
 
-procPointAnalysis :: ProcPointSet -> CmmGraph -> FuelUniqSM (BlockEnv Status)
+procPointAnalysis :: ProcPointSet -> CmmGraph -> UniqSM (BlockEnv Status)
 -- Once you know what the proc-points are, figure out
 -- what proc-points each block is reachable from
 procPointAnalysis procPoints g =
@@ -156,13 +151,13 @@ callProcPoints g = foldGraphBlocks add (setSingleton (g_entry g)) g
                       _ -> set
 
 minimalProcPointSet :: Platform -> ProcPointSet -> CmmGraph
-                    -> FuelUniqSM ProcPointSet
+                    -> UniqSM ProcPointSet
 -- Given the set of successors of calls (which must be proc-points)
 -- figure out the minimal set of necessary proc-points
 minimalProcPointSet platform callProcPoints g
   = extendPPSet platform g (postorderDfs g) callProcPoints
 
-extendPPSet :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> FuelUniqSM ProcPointSet
+extendPPSet :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> UniqSM ProcPointSet
 extendPPSet platform g blocks procPoints =
     do env <- procPointAnalysis procPoints g
        -- pprTrace "extensPPSet" (ppr env) $ return ()
@@ -212,10 +207,9 @@ extendPPSet platform g blocks procPoints =
 -- ToDo: use the _ret naming convention that the old code generator
 -- used. -- EZY
 splitAtProcPoints :: CLabel -> ProcPointSet-> ProcPointSet -> BlockEnv Status ->
-                     CmmDecl -> FuelUniqSM [CmmDecl]
+                     CmmDecl -> UniqSM [CmmDecl]
 splitAtProcPoints entry_label callPPs procPoints procMap
-                  (CmmProc (TopInfo {info_tbl=info_tbl,
-                                     stack_info=stack_info})
+                  (CmmProc (TopInfo {info_tbl=info_tbl})
                            top_l g@(CmmGraph {g_entry=entry})) =
   do -- Build a map from procpoints to the blocks they reach
      let addBlock b graphEnv =
diff --git a/compiler/cmm/CmmRewriteAssignments.hs b/compiler/cmm/CmmRewriteAssignments.hs
index 2c33b7b5ac..cf349a0334 100644
--- a/compiler/cmm/CmmRewriteAssignments.hs
+++ b/compiler/cmm/CmmRewriteAssignments.hs
@@ -18,10 +18,9 @@ module CmmRewriteAssignments
 import Cmm
 import CmmUtils
 import CmmOpt
-import OptimizationFuel
 import StgCmmUtils
 
-import Control.Monad
+import UniqSupply
 import Platform
 import UniqFM
 import Unique
@@ -29,12 +28,13 @@ import BlockId
 
 import Hoopl
 import Data.Maybe
+import Control.Monad
 import Prelude hiding (succ, zip)
 
 ----------------------------------------------------------------
 --- Main function
 
-rewriteAssignments :: Platform -> CmmGraph -> FuelUniqSM CmmGraph
+rewriteAssignments :: Platform -> CmmGraph -> UniqSM CmmGraph
 rewriteAssignments platform g = do
   -- Because we need to act on forwards and backwards information, we
   -- first perform usage analysis and bake this information into the
@@ -213,7 +213,7 @@ usageTransfer = mkBTransfer3 first middle last
           increaseUsage f r = addToUFM_C combine f r SingleUse
             where combine _ _ = ManyUse
 
-usageRewrite :: BwdRewrite FuelUniqSM (WithRegUsage CmmNode) UsageMap
+usageRewrite :: BwdRewrite UniqSM (WithRegUsage CmmNode) UsageMap
 usageRewrite = mkBRewrite3 first middle last
     where first  _ _ = return Nothing
           middle :: Monad m => WithRegUsage CmmNode O O -> UsageMap -> m (Maybe (Graph (WithRegUsage CmmNode) O O))
@@ -226,7 +226,7 @@ usageRewrite = mkBRewrite3 first middle last
           last   _ _ = return Nothing
 
 type CmmGraphWithRegUsage = GenCmmGraph (WithRegUsage CmmNode)
-annotateUsage :: CmmGraph -> FuelUniqSM (CmmGraphWithRegUsage)
+annotateUsage :: CmmGraph -> UniqSM (CmmGraphWithRegUsage)
 annotateUsage vanilla_g =
     let g = modifyGraph liftRegUsage vanilla_g
     in liftM fst $ dataflowPassBwd g [(g_entry g, fact_bot usageLattice)] $
@@ -524,7 +524,7 @@ assignmentTransfer = mkFTransfer3 (flip const) middleAssignment ((mkFactBase ass
 -- values from the assignment map, due to reassignment of the local
 -- register.)  This is probably not locally sound.
 
-assignmentRewrite :: FwdRewrite FuelUniqSM (WithRegUsage CmmNode) AssignmentMap
+assignmentRewrite :: FwdRewrite UniqSM (WithRegUsage CmmNode) AssignmentMap
 assignmentRewrite = mkFRewrite3 first middle last
     where
         first _ _ = return Nothing
@@ -605,7 +605,7 @@ assignmentRewrite = mkFRewrite3 first middle last
 -- in literals, which we can inline more aggressively, and inlining
 -- gives us opportunities for more folding.  However, we don't need any
 -- facts to do MachOp folding.
-machOpFoldRewrite :: Platform -> FwdRewrite FuelUniqSM (WithRegUsage CmmNode) a
+machOpFoldRewrite :: Platform -> FwdRewrite UniqSM (WithRegUsage CmmNode) a
 machOpFoldRewrite platform = mkFRewrite3 first middle last
   where first _ _ = return Nothing
         middle :: WithRegUsage CmmNode O O -> a -> GenCmmReplGraph (WithRegUsage CmmNode) O O
diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs
index c7fedad05b..726f98e8a3 100644
--- a/compiler/cmm/CmmStackLayout.hs
+++ b/compiler/cmm/CmmStackLayout.hs
@@ -35,7 +35,6 @@ import CmmProcPoint
 import Maybes
 import MkGraph (stackStubExpr)
 import Control.Monad
-import OptimizationFuel
 import Outputable
 import SMRep (ByteOff)
 
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index d831a8aba5..f2e4d8e183 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -80,7 +80,6 @@ import Cmm
 import BlockId
 import CLabel
 import Outputable
-import OptimizationFuel as F
 import Unique
 import UniqSupply
 import Constants( wORD_SIZE, tAG_MASK )
@@ -89,7 +88,6 @@ import Util
 import Data.Word
 import Data.Maybe
 import Data.Bits
-import Control.Monad
 import Hoopl
 
 ---------------------------------------------------
@@ -431,10 +429,10 @@ mapGraphNodes :: ( CmmNode C O -> CmmNode C O
                  , CmmNode O C -> CmmNode O C)
               -> CmmGraph -> CmmGraph
 mapGraphNodes funs@(mf,_,_) g =
-  ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (blockMapNodes3 funs) $ toBlockMap g
+  ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (mapBlock3' funs) $ toBlockMap g
 
 mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph
-mapGraphNodes1 f g = modifyGraph (graphMapBlocks (blockMapNodes f)) g
+mapGraphNodes1 f = modifyGraph (mapGraph f)
 
 
 foldGraphBlocks :: (CmmBlock -> a -> a) -> a -> CmmGraph -> a
@@ -447,21 +445,21 @@ postorderDfs g = {-# SCC "postorderDfs" #-} postorder_dfs_from (toBlockMap g) (g
 -- Running dataflow analysis and/or rewrites
 
 -- Constructing forward and backward analysis-only pass
-analFwd    :: DataflowLattice f -> FwdTransfer n f -> FwdPass FuelUniqSM n f
-analBwd    :: DataflowLattice f -> BwdTransfer n f -> BwdPass FuelUniqSM n f
+analFwd    :: DataflowLattice f -> FwdTransfer n f -> FwdPass UniqSM n f
+analBwd    :: DataflowLattice f -> BwdTransfer n f -> BwdPass UniqSM n f
 
 analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
 analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
 
 -- Constructing forward and backward analysis + rewrite pass
 analRewFwd :: DataflowLattice f -> FwdTransfer n f
-           -> FwdRewrite FuelUniqSM n f
-           -> FwdPass FuelUniqSM n f
+           -> FwdRewrite UniqSM n f
+           -> FwdPass UniqSM n f
 
 analRewBwd :: DataflowLattice f
            -> BwdTransfer n f
-           -> BwdRewrite FuelUniqSM n f
-           -> BwdPass FuelUniqSM n f
+           -> BwdRewrite UniqSM n f
+           -> BwdPass UniqSM n f
 
 analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
 analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
@@ -469,23 +467,23 @@ analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewr
 -- Running forward and backward dataflow analysis + optional rewrite
 dataflowPassFwd :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
-                -> FwdPass FuelUniqSM n f
-                -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
+                -> FwdPass UniqSM n f
+                -> UniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
 
 dataflowAnalFwd :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
-                -> FwdPass FuelUniqSM n f
+                -> FwdPass UniqSM n f
                 -> BlockEnv f
 dataflowAnalFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd =
   analyzeFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
 
 dataflowAnalFwdBlocks :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
-                -> FwdPass FuelUniqSM n f
-                -> FuelUniqSM (BlockEnv f)
+                -> FwdPass UniqSM n f
+                -> UniqSM (BlockEnv f)
 dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
 --  (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
 --  return facts
@@ -493,15 +491,15 @@ dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
 
 dataflowAnalBwd :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
-                -> BwdPass FuelUniqSM n f
+                -> BwdPass UniqSM n f
                 -> BlockEnv f
 dataflowAnalBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd =
   analyzeBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
 
 dataflowPassBwd :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
-                -> BwdPass FuelUniqSM n f
-                -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
+                -> BwdPass UniqSM n f
+                -> UniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs
index 404482e047..0eca85cb8a 100644
--- a/compiler/cmm/Hoopl.hs
+++ b/compiler/cmm/Hoopl.hs
@@ -1,7 +1,8 @@
 module Hoopl (
     module Compiler.Hoopl,
     module Hoopl.Dataflow,
-    deepBwdRw3, deepBwdRw,
+    deepFwdRw, deepFwdRw3,
+    deepBwdRw, deepBwdRw3,
     thenFwdRw
   ) where
 
@@ -10,7 +11,7 @@ import Compiler.Hoopl hiding
     FwdTransfer(..), FwdRewrite(..), FwdPass(..),
     BwdTransfer(..), BwdRewrite(..), BwdPass(..),
     noFwdRewrite, noBwdRewrite,
---    analyzeAndRewriteFwd, analyzeAndRewriteBwd,
+    analyzeAndRewriteFwd, analyzeAndRewriteBwd,
     mkFactBase, Fact,
     mkBRewrite, mkBRewrite3, mkBTransfer, mkBTransfer3,
     mkFRewrite, mkFRewrite3, mkFTransfer, mkFTransfer3,
@@ -19,53 +20,53 @@ import Compiler.Hoopl hiding
   )
 
 import Hoopl.Dataflow
-import OptimizationFuel
 import Control.Monad
+import UniqSupply
 
-deepFwdRw3 :: (n C O -> f -> FuelUniqSM (Maybe (Graph n C O)))
-           -> (n O O -> f -> FuelUniqSM (Maybe (Graph n O O)))
-           -> (n O C -> f -> FuelUniqSM (Maybe (Graph n O C)))
-           -> (FwdRewrite FuelUniqSM n f)
-deepFwdRw :: (forall e x . n e x -> f -> FuelUniqSM (Maybe (Graph n e x))) -> FwdRewrite FuelUniqSM n f
+deepFwdRw3 :: (n C O -> f -> UniqSM (Maybe (Graph n C O)))
+           -> (n O O -> f -> UniqSM (Maybe (Graph n O O)))
+           -> (n O C -> f -> UniqSM (Maybe (Graph n O C)))
+           -> (FwdRewrite UniqSM n f)
+deepFwdRw :: (forall e x . n e x -> f -> UniqSM (Maybe (Graph n e x))) -> FwdRewrite UniqSM n f
 deepFwdRw3 f m l = iterFwdRw $ mkFRewrite3 f m l
 deepFwdRw f = deepFwdRw3 f f f
 
 -- N.B. rw3, rw3', and rw3a are triples of functions.
 -- But rw and rw' are single functions.
 thenFwdRw :: forall n f.
-             FwdRewrite FuelUniqSM n f
-          -> FwdRewrite FuelUniqSM n f 
-          -> FwdRewrite FuelUniqSM n f
+             FwdRewrite UniqSM n f
+          -> FwdRewrite UniqSM n f 
+          -> FwdRewrite UniqSM n f
 thenFwdRw rw3 rw3' = wrapFR2 thenrw rw3 rw3'
  where
   thenrw :: forall e x t t1.
-               (t -> t1 -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f)))
-            -> (t -> t1 -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f)))
+               (t -> t1 -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
+            -> (t -> t1 -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
             -> t
             -> t1
-            -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f))
+            -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f))
   thenrw rw rw' n f = rw n f >>= fwdRes
      where fwdRes Nothing   = rw' n f
            fwdRes (Just gr) = return $ Just $ fadd_rw rw3' gr
 
-iterFwdRw :: forall m n f.
-             FwdRewrite FuelUniqSM n f
-          -> FwdRewrite FuelUniqSM n f
+iterFwdRw :: forall n f.
+             FwdRewrite UniqSM n f
+          -> FwdRewrite UniqSM n f
 iterFwdRw rw3 = wrapFR iter rw3
  where iter :: forall a e x t.
-               (t -> a -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f)))
+               (t -> a -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
                -> t
                -> a
-               -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f))
+               -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f))
        iter rw n = (liftM $ liftM $ fadd_rw (iterFwdRw rw3)) . rw n
 
 -- | Function inspired by 'rew' in the paper
-_frewrite_cps :: ((Graph n e x, FwdRewrite FuelUniqSM n f) -> FuelUniqSM a)
-             -> FuelUniqSM a
-             -> (forall e x . n e x -> f -> FuelUniqSM (Maybe (Graph n e x, FwdRewrite FuelUniqSM n f)))
+_frewrite_cps :: ((Graph n e x, FwdRewrite UniqSM n f) -> UniqSM a)
+             -> UniqSM a
+             -> (forall e x . n e x -> f -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
              -> n e x
              -> f
-             -> FuelUniqSM a
+             -> UniqSM a
 _frewrite_cps j n rw node f =
     do mg <- rw node f
        case mg of Nothing -> n
@@ -74,51 +75,51 @@ _frewrite_cps j n rw node f =
 
 
 -- | Function inspired by 'add' in the paper
-fadd_rw :: FwdRewrite FuelUniqSM n f
-        -> (Graph n e x, FwdRewrite FuelUniqSM n f)
-        -> (Graph n e x, FwdRewrite FuelUniqSM n f)
+fadd_rw :: FwdRewrite UniqSM n f
+        -> (Graph n e x, FwdRewrite UniqSM n f)
+        -> (Graph n e x, FwdRewrite UniqSM n f)
 fadd_rw rw2 (g, rw1) = (g, rw1 `thenFwdRw` rw2)
 
 
 
 deepBwdRw3 ::
-              (n C O -> f          -> FuelUniqSM (Maybe (Graph n C O)))
-           -> (n O O -> f          -> FuelUniqSM (Maybe (Graph n O O)))
-           -> (n O C -> FactBase f -> FuelUniqSM (Maybe (Graph n O C)))
-           -> (BwdRewrite FuelUniqSM n f)
-deepBwdRw  :: (forall e x . n e x -> Fact x f -> FuelUniqSM (Maybe (Graph n e x)))
-           -> BwdRewrite FuelUniqSM n f
+              (n C O -> f          -> UniqSM (Maybe (Graph n C O)))
+           -> (n O O -> f          -> UniqSM (Maybe (Graph n O O)))
+           -> (n O C -> FactBase f -> UniqSM (Maybe (Graph n O C)))
+           -> (BwdRewrite UniqSM n f)
+deepBwdRw  :: (forall e x . n e x -> Fact x f -> UniqSM (Maybe (Graph n e x)))
+           -> BwdRewrite UniqSM n f
 deepBwdRw3 f m l = iterBwdRw $ mkBRewrite3 f m l
 deepBwdRw  f = deepBwdRw3 f f f
 
 
-thenBwdRw :: forall n f. BwdRewrite FuelUniqSM n f -> BwdRewrite FuelUniqSM n f -> BwdRewrite FuelUniqSM n f
+thenBwdRw :: forall n f. BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f
 thenBwdRw rw1 rw2 = wrapBR2 f rw1 rw2
   where f :: forall t t1 t2 e x.
              t
-             -> (t1 -> t2 -> FuelUniqSM (Maybe (Graph n e x, BwdRewrite FuelUniqSM n f)))
-             -> (t1 -> t2 -> FuelUniqSM (Maybe (Graph n e x, BwdRewrite FuelUniqSM n f)))
+             -> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
+             -> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
              -> t1
              -> t2
-             -> FuelUniqSM (Maybe (Graph n e x, BwdRewrite FuelUniqSM n f))
+             -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f))
         f _ rw1 rw2' n f = do
           res1 <- rw1 n f
           case res1 of
             Nothing -> rw2' n f
             Just gr -> return $ Just $ badd_rw rw2 gr
 
-iterBwdRw :: forall n f. BwdRewrite FuelUniqSM n f -> BwdRewrite FuelUniqSM n f
+iterBwdRw :: forall n f. BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f
 iterBwdRw rw = wrapBR f rw
   where f :: forall t e x t1 t2.
              t
-             -> (t1 -> t2 -> FuelUniqSM (Maybe (Graph n e x, BwdRewrite FuelUniqSM n f)))
+             -> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
              -> t1
              -> t2
-             -> FuelUniqSM (Maybe (Graph n e x, BwdRewrite FuelUniqSM n f))
+             -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f))
         f _ rw' n f = liftM (liftM (badd_rw (iterBwdRw rw))) (rw' n f)
 
 -- | Function inspired by 'add' in the paper
-badd_rw :: BwdRewrite FuelUniqSM n f
-        -> (Graph n e x, BwdRewrite FuelUniqSM n f)
-        -> (Graph n e x, BwdRewrite FuelUniqSM n f)
+badd_rw :: BwdRewrite UniqSM n f
+        -> (Graph n e x, BwdRewrite UniqSM n f)
+        -> (Graph n e x, BwdRewrite UniqSM n f)
 badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2)
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index cdab2cd2fe..9745eac9d8 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -1,3 +1,14 @@
+--
+-- Copyright (c) 2010, João Dias, Simon Marlow, Simon Peyton Jones,
+-- and Norman Ramsey
+--
+-- Modifications copyright (c) The University of Glasgow 2012
+--
+-- This module is a specialised and optimised version of
+-- Compiler.Hoopl.Dataflow in the hoopl package.  In particular it is
+-- specialised to the UniqSM monad.
+--
+
 {-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, MultiParamTypeClasses #-}
 #if __GLASGOW_HASKELL__ >= 703
 {-# OPTIONS_GHC -fprof-auto-top #-}
@@ -23,78 +34,64 @@ module Hoopl.Dataflow
   )
 where
 
-import OptimizationFuel
+import UniqSupply
 
 import Data.Maybe
 import Data.Array
 
-import Compiler.Hoopl.Collections
-import Compiler.Hoopl.Fuel
-import Compiler.Hoopl.Graph hiding (Graph) -- hiding so we can redefine
-                                           -- and include definition in paper
-import qualified Compiler.Hoopl.GraphUtil as U
-import Compiler.Hoopl.Label
-import Compiler.Hoopl.Dataflow (JoinFun)
-import Compiler.Hoopl.Util
-
-import Compiler.Hoopl.Dataflow (
-    DataflowLattice(..), OldFact(..), NewFact(..), Fact
-  , ChangeFlag(..), mkFactBase
-  , FwdPass(..), FwdRewrite(..), FwdTransfer(..), mkFRewrite,  getFRewrite3, mkFTransfer, mkFTransfer3
-  , wrapFR, wrapFR2
-  , BwdPass(..), BwdRewrite(..),  BwdTransfer(..), mkBTransfer, mkBTransfer3, getBTransfer3
+import Compiler.Hoopl hiding
+   ( mkBRewrite3, mkFRewrite3, noFwdRewrite, noBwdRewrite
+   , analyzeAndRewriteBwd, analyzeAndRewriteFwd
+   )
+import Compiler.Hoopl.Internals
+  ( wrapFR, wrapFR2
   , wrapBR, wrapBR2
-  , mkBRewrite,  getBRewrite3
+  , splice
   )
 
--- import Debug.Trace
 
-noRewrite :: a -> b -> FuelUniqSM (Maybe c)
+-- -----------------------------------------------------------------------------
+
+noRewrite :: a -> b -> UniqSM (Maybe c)
 noRewrite _ _ = return Nothing
 
-noFwdRewrite :: FwdRewrite FuelUniqSM n f
+noFwdRewrite :: FwdRewrite UniqSM n f
 noFwdRewrite = FwdRewrite3 (noRewrite, noRewrite, noRewrite)
 
 -- | Functions passed to 'mkFRewrite3' should not be aware of the fuel supply.
 -- The result returned by 'mkFRewrite3' respects fuel.
 mkFRewrite3 :: forall n f.
-               (n C O -> f -> FuelUniqSM (Maybe (Graph n C O)))
-            -> (n O O -> f -> FuelUniqSM (Maybe (Graph n O O)))
-            -> (n O C -> f -> FuelUniqSM (Maybe (Graph n O C)))
-            -> FwdRewrite FuelUniqSM n f
+               (n C O -> f -> UniqSM (Maybe (Graph n C O)))
+            -> (n O O -> f -> UniqSM (Maybe (Graph n O O)))
+            -> (n O C -> f -> UniqSM (Maybe (Graph n O C)))
+            -> FwdRewrite UniqSM n f
 mkFRewrite3 f m l = FwdRewrite3 (lift f, lift m, lift l)
-  where lift :: forall t t1 a. (t -> t1 -> FuelUniqSM (Maybe a))
-                             -> t -> t1 -> FuelUniqSM (Maybe (a, FwdRewrite FuelUniqSM n f))
+  where lift :: forall t t1 a. (t -> t1 -> UniqSM (Maybe a))
+                             -> t -> t1 -> UniqSM (Maybe (a, FwdRewrite UniqSM n f))
         {-# INLINE lift #-}
         lift rw node fact = do
              a <- rw node fact
              case a of
                Nothing -> return Nothing
-               Just a  -> do f <- getFuel
-                             if f == 0
-                                then return Nothing
-                                else setFuel (f-1) >> return (Just (a,noFwdRewrite))
+               Just a  -> return (Just (a,noFwdRewrite))
 
-noBwdRewrite :: BwdRewrite FuelUniqSM n f
+noBwdRewrite :: BwdRewrite UniqSM n f
 noBwdRewrite = BwdRewrite3 (noRewrite, noRewrite, noRewrite)
 
 mkBRewrite3 :: forall n f.
-               (n C O -> f          -> FuelUniqSM (Maybe (Graph n C O)))
-            -> (n O O -> f          -> FuelUniqSM (Maybe (Graph n O O)))
-            -> (n O C -> FactBase f -> FuelUniqSM (Maybe (Graph n O C)))
-            -> BwdRewrite FuelUniqSM n f
+               (n C O -> f          -> UniqSM (Maybe (Graph n C O)))
+            -> (n O O -> f          -> UniqSM (Maybe (Graph n O O)))
+            -> (n O C -> FactBase f -> UniqSM (Maybe (Graph n O C)))
+            -> BwdRewrite UniqSM n f
 mkBRewrite3 f m l = BwdRewrite3 (lift f, lift m, lift l)
-  where lift :: forall t t1 a. (t -> t1 -> FuelUniqSM (Maybe a))
-                             -> t -> t1 -> FuelUniqSM (Maybe (a, BwdRewrite FuelUniqSM n f))
+  where lift :: forall t t1 a. (t -> t1 -> UniqSM (Maybe a))
+                             -> t -> t1 -> UniqSM (Maybe (a, BwdRewrite UniqSM n f))
         {-# INLINE lift #-}
         lift rw node fact = do
              a <- rw node fact
              case a of
                Nothing -> return Nothing
-               Just a  -> do f <- getFuel
-                             if f == 0
-                                then return Nothing
-                                else setFuel (f-1) >> return (Just (a,noBwdRewrite))
+               Just a  -> return (Just (a,noBwdRewrite))
 
 -----------------------------------------------------------------------------
 --              Analyze and rewrite forward: the interface
@@ -104,10 +101,10 @@ mkBRewrite3 f m l = BwdRewrite3 (lift f, lift m, lift l)
 --   be no other entry point, or all goes horribly wrong...
 analyzeAndRewriteFwd
    :: forall n f e x .  NonLocal n =>
-      FwdPass FuelUniqSM n f
+      FwdPass UniqSM n f
    -> MaybeC e [Label]
    -> Graph n  e x -> Fact e f
-   -> FuelUniqSM (Graph n e x, FactBase f, MaybeO x f)
+   -> UniqSM (Graph n e x, FactBase f, MaybeO x f)
 analyzeAndRewriteFwd pass entries g f =
   do (rg, fout) <- arfGraph pass (fmap targetLabels entries) g f
      let (g', fb) = normalizeGraph rg
@@ -128,8 +125,8 @@ distinguishedExitFact g f = maybe g
 type Entries e = MaybeC e [Label]
 
 arfGraph :: forall n f e x .  NonLocal n =>
-            FwdPass FuelUniqSM n f ->
-            Entries e -> Graph n e x -> Fact e f -> FuelUniqSM (DG f n e x, Fact x f)
+            FwdPass UniqSM n f ->
+            Entries e -> Graph n e x -> Fact e f -> UniqSM (DG f n e x, Fact x f)
 arfGraph pass@FwdPass { fp_lattice = lattice,
                         fp_transfer = transfer,
                         fp_rewrite  = rewrite } entries g in_fact = graph g in_fact
@@ -138,32 +135,32 @@ arfGraph pass@FwdPass { fp_lattice = lattice,
     type ARF  thing = forall e x . thing e x -> f        -> m (DG f n e x, Fact x f)
     type ARFX thing = forall e x . thing e x -> Fact e f -> m (DG f n e x, Fact x f)
     -}
-    graph ::              Graph n e x -> Fact e f -> FuelUniqSM (DG f n e x, Fact x f)
+    graph ::              Graph n e x -> Fact e f -> UniqSM (DG f n e x, Fact x f)
     block :: forall e x .
-             Block n e x -> f -> FuelUniqSM (DG f n e x, Fact x f)
+             Block n e x -> f -> UniqSM (DG f n e x, Fact x f)
 
     body  :: [Label] -> LabelMap (Block n C C)
-          -> Fact C f -> FuelUniqSM (DG f n C C, Fact C f)
+          -> Fact C f -> UniqSM (DG f n C C, Fact C f)
                     -- Outgoing factbase is restricted to Labels *not* in
                     -- in the Body; the facts for Labels *in*
                     -- the Body are in the 'DG f n C C'
 
     cat :: forall e a x f1 f2 f3.
-           (f1 -> FuelUniqSM (DG f n e a, f2))
-        -> (f2 -> FuelUniqSM (DG f n a x, f3))
-        -> (f1 -> FuelUniqSM (DG f n e x, f3))
+           (f1 -> UniqSM (DG f n e a, f2))
+        -> (f2 -> UniqSM (DG f n a x, f3))
+        -> (f1 -> UniqSM (DG f n e x, f3))
 
     graph GNil            f = return (dgnil, f)
     graph (GUnit blk)     f = block blk f
     graph (GMany e bdy x) f = ((e `ebcat` bdy) `cat` exit x) f
      where
-      ebcat :: MaybeO e (Block n O C) -> Body n -> Fact e f -> FuelUniqSM (DG f n e C, Fact C f)
-      exit  :: MaybeO x (Block n C O)           -> Fact C f -> FuelUniqSM (DG f n C x, Fact x f)
+      ebcat :: MaybeO e (Block n O C) -> Body n -> Fact e f -> UniqSM (DG f n e C, Fact C f)
+      exit  :: MaybeO x (Block n C O)           -> Fact C f -> UniqSM (DG f n C x, Fact x f)
       exit (JustO blk) f = arfx block blk f
       exit NothingO    f = return (dgnilC, f)
       ebcat entry bdy f = c entries entry f
        where c :: MaybeC e [Label] -> MaybeO e (Block n O C)
-                -> Fact e f -> FuelUniqSM (DG f n e C, Fact C f)
+                -> Fact e f -> UniqSM (DG f n e C, Fact C f)
              c NothingC (JustO entry)   f = (block entry `cat` body (successors entry) bdy) f
              c (JustC entries) NothingO f = body entries bdy f
              c _ _ _ = error "bogus GADT pattern match failure"
@@ -181,7 +178,7 @@ arfGraph pass@FwdPass { fp_lattice = lattice,
 
     {-# INLINE node #-}
     node :: forall e x . (ShapeLifter e x)
-         => n e x -> f -> FuelUniqSM (DG f n e x, Fact x f)
+         => n e x -> f -> UniqSM (DG f n e x, Fact x f)
     node n f
      = do { grw <- frewrite rewrite n f
           ; case grw of
@@ -201,8 +198,8 @@ arfGraph pass@FwdPass { fp_lattice = lattice,
                        ; return (g, f2) }
 
     arfx :: forall x .
-            (Block n C x ->        f -> FuelUniqSM (DG f n C x, Fact x f))
-         -> (Block n C x -> Fact C f -> FuelUniqSM (DG f n C x, Fact x f))
+            (Block n C x ->        f -> UniqSM (DG f n C x, Fact x f))
+         -> (Block n C x -> Fact C f -> UniqSM (DG f n C x, Fact x f))
     arfx arf thing fb = 
       arf thing $ fromJust $ lookupFact (entryLabel thing) $ joinInFacts lattice fb
      -- joinInFacts adds debugging information
@@ -216,7 +213,7 @@ arfGraph pass@FwdPass { fp_lattice = lattice,
       where
         lattice = fp_lattice pass
         do_block :: forall x . Block n C x -> FactBase f
-                 -> FuelUniqSM (DG f n C x, Fact x f)
+                 -> UniqSM (DG f n C x, Fact x f)
         do_block b fb = block b entryFact
           where entryFact = getFact lattice (entryLabel b) fb
 
@@ -243,7 +240,7 @@ forwardBlockList entries blks = postorder_dfs_from blks entries
 --   be no other entry point, or all goes horribly wrong...
 analyzeFwd
    :: forall n f e .  NonLocal n =>
-      FwdPass FuelUniqSM n f
+      FwdPass UniqSM n f
    -> MaybeC e [Label]
    -> Graph n e C -> Fact e f
    -> FactBase f
@@ -286,7 +283,7 @@ analyzeFwd FwdPass { fp_lattice = lattice,
 --   be no other entry point, or all goes horribly wrong...
 analyzeFwdBlocks
    :: forall n f e .  NonLocal n =>
-      FwdPass FuelUniqSM n f
+      FwdPass UniqSM n f
    -> MaybeC e [Label]
    -> Graph n e C -> Fact e f
    -> FactBase f
@@ -315,6 +312,7 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice,
     block (BlockCO n _)   f = ftr n f
     block (BlockCC l _ n) f = (ftr l `cat` ltr n) f
     block (BlockOC   _ n) f = ltr n f
+    block _               _ = error "analyzeFwdBlocks"
 
     {-# INLINE cat #-}
     cat :: forall f1 f2 f3 . (f1 -> f2) -> (f2 -> f3) -> (f1 -> f3)
@@ -328,7 +326,7 @@ analyzeFwdBlocks FwdPass { fp_lattice = lattice,
 --   be no other entry point, or all goes horribly wrong...
 analyzeBwd
    :: forall n f e .  NonLocal n =>
-      BwdPass FuelUniqSM n f
+      BwdPass UniqSM n f
    -> MaybeC e [Label]
    -> Graph n e C -> Fact C f
    -> FactBase f
@@ -375,9 +373,9 @@ analyzeBwd BwdPass { bp_lattice = lattice,
 --   quite understand the implications of possible other exits
 analyzeAndRewriteBwd
    :: NonLocal n
-   => BwdPass FuelUniqSM n f
+   => BwdPass UniqSM n f
    -> MaybeC e [Label] -> Graph n e x -> Fact x f
-   -> FuelUniqSM (Graph n e x, FactBase f, MaybeO e f)
+   -> UniqSM (Graph n e x, FactBase f, MaybeO e f)
 analyzeAndRewriteBwd pass entries g f =
   do (rg, fout) <- arbGraph pass (fmap targetLabels entries) g f
      let (g', fb) = normalizeGraph rg
@@ -398,8 +396,8 @@ distinguishedEntryFact g f = maybe g
 
 arbGraph :: forall n f e x .
             NonLocal n =>
-            BwdPass FuelUniqSM n f ->
-            Entries e -> Graph n e x -> Fact x f -> FuelUniqSM (DG f n e x, Fact e f)
+            BwdPass UniqSM n f ->
+            Entries e -> Graph n e x -> Fact x f -> UniqSM (DG f n e x, Fact e f)
 arbGraph pass@BwdPass { bp_lattice  = lattice,
                         bp_transfer = transfer,
                         bp_rewrite  = rewrite } entries g in_fact = graph g in_fact
@@ -408,27 +406,27 @@ arbGraph pass@BwdPass { bp_lattice  = lattice,
     type ARB  thing = forall e x . thing e x -> Fact x f -> m (DG f n e x, f)
     type ARBX thing = forall e x . thing e x -> Fact x f -> m (DG f n e x, Fact e f)
     -}
-    graph ::              Graph n e x -> Fact x f -> FuelUniqSM (DG f n e x, Fact e f)
-    block :: forall e x . Block n e x -> Fact x f -> FuelUniqSM (DG f n e x, f)
-    body  :: [Label] -> Body n -> Fact C f -> FuelUniqSM (DG f n C C, Fact C f)
+    graph ::              Graph n e x -> Fact x f -> UniqSM (DG f n e x, Fact e f)
+    block :: forall e x . Block n e x -> Fact x f -> UniqSM (DG f n e x, f)
+    body  :: [Label] -> Body n -> Fact C f -> UniqSM (DG f n C C, Fact C f)
     node  :: forall e x . (ShapeLifter e x) 
-             => n e x       -> Fact x f -> FuelUniqSM (DG f n e x, f)
+             => n e x       -> Fact x f -> UniqSM (DG f n e x, f)
     cat :: forall e a x info info' info''.
-           (info' -> FuelUniqSM (DG f n e a, info''))
-        -> (info  -> FuelUniqSM (DG f n a x, info'))
-        -> (info  -> FuelUniqSM (DG f n e x, info''))
+           (info' -> UniqSM (DG f n e a, info''))
+        -> (info  -> UniqSM (DG f n a x, info'))
+        -> (info  -> UniqSM (DG f n e x, info''))
 
     graph GNil            f = return (dgnil, f)
     graph (GUnit blk)     f = block blk f
     graph (GMany e bdy x) f = ((e `ebcat` bdy) `cat` exit x) f
      where
-      ebcat :: MaybeO e (Block n O C) -> Body n -> Fact C f -> FuelUniqSM (DG f n e C, Fact e f)
-      exit  :: MaybeO x (Block n C O)           -> Fact x f -> FuelUniqSM (DG f n C x, Fact C f)
+      ebcat :: MaybeO e (Block n O C) -> Body n -> Fact C f -> UniqSM (DG f n e C, Fact e f)
+      exit  :: MaybeO x (Block n C O)           -> Fact x f -> UniqSM (DG f n C x, Fact C f)
       exit (JustO blk) f = arbx block blk f
       exit NothingO    f = return (dgnilC, f)
       ebcat entry bdy f = c entries entry f
        where c :: MaybeC e [Label] -> MaybeO e (Block n O C)
-                -> Fact C f -> FuelUniqSM (DG f n e C, Fact e f)
+                -> Fact C f -> UniqSM (DG f n e C, Fact e f)
              c NothingC (JustO entry)   f = (block entry `cat` body (successors entry) bdy) f
              c (JustC entries) NothingO f = body entries bdy f
              c _ _ _ = error "bogus GADT pattern match failure"
@@ -464,8 +462,8 @@ arbGraph pass@BwdPass { bp_lattice  = lattice,
                        ; return (g, f1) }
 
     arbx :: forall x .
-            (Block n C x -> Fact x f -> FuelUniqSM (DG f n C x, f))
-         -> (Block n C x -> Fact x f -> FuelUniqSM (DG f n C x, Fact C f))
+            (Block n C x -> Fact x f -> UniqSM (DG f n C x, f))
+         -> (Block n C x -> Fact x f -> UniqSM (DG f n C x, Fact C f))
 
     arbx arb thing f = do { (rg, f) <- arb thing f
                           ; let fb = joinInFacts (bp_lattice pass) $
@@ -479,7 +477,7 @@ arbGraph pass@BwdPass { bp_lattice  = lattice,
     body entries blockmap init_fbase
       = fixpoint Bwd (bp_lattice pass) do_block entries blockmap init_fbase
       where
-        do_block :: forall x. Block n C x -> Fact x f -> FuelUniqSM (DG f n C x, LabelMap f)
+        do_block :: forall x. Block n C x -> Fact x f -> UniqSM (DG f n C x, LabelMap f)
         do_block b f = do (g, f) <- block b f
                           return (g, mapSingleton (entryLabel b) f)
 
@@ -514,7 +512,7 @@ fixpointAnal :: forall n f. NonLocal n
  -> LabelMap (Block n C C)
  -> Fact C f -> FactBase f
 
-fixpointAnal direction DataflowLattice{ fact_bot = bot, fact_join = join }
+fixpointAnal direction DataflowLattice{ fact_bot = _, fact_join = join }
               do_block entries blockmap init_fbase
   = loop start init_fbase
   where
@@ -553,12 +551,12 @@ fixpointAnal direction DataflowLattice{ fact_bot = bot, fact_join = join }
 fixpoint :: forall n f. NonLocal n
  => Direction
  -> DataflowLattice f
- -> (Block n C C -> Fact C f -> FuelUniqSM (DG f n C C, Fact C f))
+ -> (Block n C C -> Fact C f -> UniqSM (DG f n C C, Fact C f))
  -> [Label]
  -> LabelMap (Block n C C)
- -> (Fact C f -> FuelUniqSM (DG f n C C, Fact C f))
+ -> (Fact C f -> UniqSM (DG f n C C, Fact C f))
 
-fixpoint direction DataflowLattice{ fact_bot = bot, fact_join = join }
+fixpoint direction DataflowLattice{ fact_bot = _, fact_join = join }
          do_block entries blockmap init_fbase
   = do
         -- trace ("fixpoint: " ++ show (case direction of Fwd -> True; Bwd -> False) ++ " " ++ show (mapKeys blockmap) ++ show entries ++ " " ++ show (mapKeys init_fbase)) $ return()
@@ -580,7 +578,7 @@ fixpoint direction DataflowLattice{ fact_bot = bot, fact_join = join }
        :: IntHeap
        -> FactBase f  -- current factbase (increases monotonically)
        -> LabelMap (DBlock f n C C)  -- transformed graph
-       -> FuelUniqSM (FactBase f, LabelMap (DBlock f n C C))
+       -> UniqSM (FactBase f, LabelMap (DBlock f n C C))
 
     loop [] fbase newblocks = return (fbase, newblocks)
     loop (ix:todo) fbase !newblocks = do
@@ -732,7 +730,6 @@ out that always recording a change is faster.
 --          TOTALLY internal to Hoopl; each block is decorated with a fact
 -----------------------------------------------------------------------------
 
-type Graph = Graph' Block
 type DG f  = Graph' (DBlock f)
 data DBlock f n e x = DBlock f (Block n e x) -- ^ block decorated with fact
 
@@ -754,7 +751,7 @@ normalizeGraph :: forall n f e x .
                  -- A Graph together with the facts for that graph
                  -- The domains of the two maps should be identical
 
-normalizeGraph g = (graphMapBlocks dropFact g, facts g)
+normalizeGraph g = (mapGraphBlocks dropFact g, facts g)
     where dropFact :: DBlock t t1 t2 t3 -> Block t1 t2 t3
           dropFact (DBlock _ b) = b
           facts :: DG f n e x -> FactBase f
@@ -774,9 +771,9 @@ normalizeGraph g = (graphMapBlocks dropFact g, facts g)
 dgnil  = GNil
 dgnilC = GMany NothingO emptyBody NothingO
 
-dgSplice = U.splice fzCat
+dgSplice = splice fzCat
   where fzCat :: DBlock f n e O -> DBlock t n O x -> DBlock f n e x
-        fzCat (DBlock f b1) (DBlock _ b2) = DBlock f $! b1 `U.cat` b2
+        fzCat (DBlock f b1) (DBlock _ b2) = DBlock f $! b1 `blockAppend` b2
         -- NB. strictness, this function is hammered.
 
 ----------------------------------------------------------------
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 797b785de2..ecd4d4f985 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -318,7 +318,7 @@ copyOutOflow conv transfer area actuals updfr_off
     (setRA, init_offset) =
       case area of
             Young id -> id `seq` -- Generate a store instruction for
-           	    	     	     -- the return address if making a call
+                                 -- the return address if making a call
                   if transfer == Call then
                     ([(CmmLit (CmmBlock id), StackParam init_offset)],
                      widthInBytes wordWidth)
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index 00bbe6d2ee..aa83afbf8d 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -9,7 +9,7 @@
 module OldCmm (
         CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl,
         ListGraph(..),
-        UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..),
+        CmmInfoTable(..), ClosureTypeInfo(..),
         CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual,
 
         cmmMapGraph, cmmTopMapGraph,
@@ -47,17 +47,6 @@ import ForeignCall
 -- with assembly-language labels.
 
 -----------------------------------------------------------------------------
---     Info Tables
------------------------------------------------------------------------------
-
--- | A frame that is to be pushed before entry to the function.
--- Used to handle 'update' frames.
-data UpdateFrame
-  = UpdateFrame
-        CmmExpr    -- Frame header.  Behaves like the target of a 'jump'.
-        [CmmExpr]  -- Frame remainder.  Behaves like the arguments of a 'jump'.
-
------------------------------------------------------------------------------
 --  Cmm, CmmDecl, CmmBasicBlock
 -----------------------------------------------------------------------------
 
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index a30be9c6c7..9990fd26a4 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -137,18 +137,6 @@ pprStmt stmt = case stmt of
 instance (Outputable a) => Outputable (CmmHinted a) where
   ppr (CmmHinted a k) = ppr (a, k)
 
-pprUpdateFrame :: UpdateFrame -> SDoc
-pprUpdateFrame (UpdateFrame expr args) =
-    hcat [ ptext (sLit "jump")
-         , space
-         , if isTrivialCmmExpr expr
-                then pprExpr expr
-                else case expr of
-                    CmmLoad (CmmReg _) _ -> pprExpr expr
-                    _ -> parens (pprExpr expr)
-         , space
-         , parens  ( commafy $ map ppr args ) ]
-
 -- --------------------------------------------------------------------------
 -- goto local label. [1], section 6.6
 --
diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
deleted file mode 100644
index 6e968c0b1d..0000000000
--- a/compiler/cmm/OptimizationFuel.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
--- | 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, amountOfFuel, tankFilledTo, unlimitedFuel, anyFuelLeft, oneLessFuel
-    , OptFuelState, initOptFuelState
-    , FuelConsumer, FuelState
-    , runFuelIO, runInfiniteFuelIO
-    , FuelUniqSM
-    , liftUniq
-    )
-where
-
-import Data.IORef
-import Control.Monad
-import StaticFlags (opt_Fuel)
-import UniqSupply
-import Panic
-import Util
-
-import Compiler.Hoopl
-import Compiler.Hoopl.GHC (getFuel, setFuel)
-
-#include "HsVersions.h"
-
-
--- We limit the number of transactions executed using a record of flags
--- stored in an HscEnv. The flags store the name of the last optimization
--- pass and the amount of optimization fuel remaining.
-data OptFuelState =
-  OptFuelState { pass_ref :: IORef String
-               , fuel_ref :: IORef OptimizationFuel
-               }
-initOptFuelState :: IO OptFuelState
-initOptFuelState =
-  do pass_ref' <- newIORef "unoptimized program"
-     fuel_ref' <- newIORef (tankFilledTo opt_Fuel)
-     return OptFuelState {pass_ref = pass_ref', fuel_ref = fuel_ref'}
-
-type FuelConsumer a = OptimizationFuel -> (a, OptimizationFuel)
-
-tankFilledTo :: Int -> OptimizationFuel
-amountOfFuel :: OptimizationFuel -> Int
-
-anyFuelLeft :: OptimizationFuel -> Bool
-oneLessFuel :: OptimizationFuel -> OptimizationFuel
-unlimitedFuel :: OptimizationFuel
-
-newtype OptimizationFuel = OptimizationFuel Int
-  deriving Show
-
-tankFilledTo = OptimizationFuel
-amountOfFuel (OptimizationFuel f) = f
-
-anyFuelLeft (OptimizationFuel f) = f > 0
-oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
-unlimitedFuel = OptimizationFuel infiniteFuel
-
-data FuelState = FuelState { fs_fuel :: {-# UNPACK #-} !OptimizationFuel,
-                             fs_lastpass :: String }
-newtype FuelUniqSM a = FUSM { unFUSM :: UniqSupply -> FuelState -> (# a, UniqSupply, FuelState #) }
-
-runFuelIO :: OptFuelState -> FuelUniqSM a -> IO a
-runFuelIO fs (FUSM f) =
-    do pass <- readIORef (pass_ref fs)
-       fuel <- readIORef (fuel_ref fs)
-       u    <- mkSplitUniqSupply 'u'
-       case f u (FuelState fuel pass) of
-          (# a, _, FuelState fuel' pass' #) -> do
-            writeIORef (pass_ref fs) pass'
-            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'
-       case f u (FuelState unlimitedFuel pass) of
-          (# a, _, FuelState _fuel pass' #) -> do
-            writeIORef (pass_ref fs) pass'
-            return a
-
-instance Monad FuelUniqSM where
-  FUSM f >>= k = FUSM (\u s -> case f u s of (# a, u', s' #) ->
-                                                unFUSM (k a) u' s')
-  return a     = FUSM (\u s -> (# a, u, s #))
-
-instance MonadUnique FuelUniqSM where
-    getUniqueSupplyM =
-       FUSM $ \us f -> case splitUniqSupply us of
-                         (us1,us2) -> (# us1, us2, f #)
-
-    getUniqueM =
-       FUSM $ \us f -> case splitUniqSupply us of
-                         (us1,us2) -> (# uniqFromSupply us1, us2, f #)
-
-    getUniquesM =
-       FUSM $ \us f -> case splitUniqSupply us of
-                         (us1,us2) -> (# uniqsFromSupply us1, us2, f #)
-
-
-liftUniq :: UniqSM x -> FuelUniqSM x
-liftUniq x = FUSM (\u s -> case initUs u x of (a,u') -> (# a, u', s #))
-
-class Monad m => FuelUsingMonad m where
-  fuelGet      :: m OptimizationFuel
-  fuelSet      :: OptimizationFuel -> m ()
-  lastFuelPass :: m String
-  setFuelPass  :: String -> m ()
-
-instance FuelUsingMonad FuelUniqSM where
-  fuelGet          = extract fs_fuel
-  lastFuelPass     = extract fs_lastpass
-  fuelSet fuel     = FUSM (\u s -> (# (), u, s { fs_fuel     = fuel } #))
-  setFuelPass pass = FUSM (\u s -> (# (), u, s { fs_lastpass = pass } #))
-
-extract :: (FuelState -> a) -> FuelUniqSM a
-extract f = FUSM (\u s -> (# f s, u, s #))
-
-instance FuelMonad FuelUniqSM where
-  getFuel = liftM amountOfFuel fuelGet
-  setFuel = fuelSet . tankFilledTo
-
--- Don't bother to checkpoint the unique supply; it doesn't matter
-instance CheckpointMonad FuelUniqSM where
-    type Checkpoint FuelUniqSM = FuelState
-    checkpoint = FUSM $ \u fuel -> (# fuel, u, fuel #)
-    restart fuel = FUSM $ \u _ -> (# (), u, fuel #)
-
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 4db1dffdfc..68bfb6d9fe 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -572,7 +572,7 @@ cgAltRhss gc_plan retry_lbl bndr alts
 	   ; return con }
 
 maybeAltHeapCheck :: GcPlan -> Maybe BlockId -> FCode a -> FCode a
-maybeAltHeapCheck NoGcInAlts      mlbl code = code
+maybeAltHeapCheck NoGcInAlts      _    code = code
 maybeAltHeapCheck (GcInAlts regs) mlbl code =
   case mlbl of
      Nothing -> altHeapCheck regs code
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 0969f5b078..3c13bb4704 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -194,7 +194,6 @@ Library
         OldCmmLint
         OldCmmUtils
         OldPprCmm
-        OptimizationFuel
         PprBase
         PprC
         PprCmm
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index 3b2354479a..e92eb4f34c 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -14,7 +14,7 @@ import LlvmCodeGen ( llvmCodeGen )
 import UniqSupply       ( mkSplitUniqSupply )
 
 import Finder           ( mkStubPaths )
-import PprC		( writeCs )
+import PprC             ( writeCs )
 import OldCmmLint       ( cmmLint )
 import Packages
 import OldCmm           ( RawCmmGroup )
@@ -45,9 +45,9 @@ import System.IO
 \begin{code}
 codeOutput :: DynFlags
            -> Module
-	   -> ModLocation
-	   -> ForeignStubs
-	   -> [PackageId]
+           -> ModLocation
+           -> ForeignStubs
+           -> [PackageId]
            -> Stream IO RawCmmGroup ()                       -- Compiled C--
            -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})
 
@@ -64,16 +64,16 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
                 { showPass dflags "CmmLint"
                 ; case cmmLint (targetPlatform dflags) cmm of
                         Just err -> do { log_action dflags dflags SevDump noSrcSpan defaultDumpStyle err
-				       ; ghcExit dflags 1
-				       }
-			Nothing  -> return ()
+                                       ; ghcExit dflags 1
+                                       }
+                        Nothing  -> return ()
                 ; return cmm
                 }
 
-	; showPass dflags "CodeOutput"
-	; let filenm = hscOutName dflags 
-	; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
-	; case hscTarget dflags of {
+        ; showPass dflags "CodeOutput"
+        ; let filenm = hscOutName dflags 
+        ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
+        ; case hscTarget dflags of {
              HscInterpreted -> return ();
              HscAsm         -> outputAsm dflags filenm linted_cmm_stream;
              HscC           -> outputC dflags filenm linted_cmm_stream pkg_deps;
@@ -127,7 +127,7 @@ outputC dflags filenm cmm_stream packages
 
        doOutput filenm $ \ h -> do
           hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
-	  hPutStr h cc_injects
+          hPutStr h cc_injects
           writeCs dflags h rawcmms
 \end{code}
 
@@ -256,4 +256,3 @@ outputForeignStubs_help fname doc_str header footer
    = do writeFile fname (header ++ doc_str ++ '\n':footer ++ "\n")
         return True
 \end{code}
-
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index eecf81455c..0b03e83029 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -125,7 +125,6 @@ import CmmParse         ( parseCmmFile )
 import CmmBuildInfoTables
 import CmmPipeline
 import CmmInfo
-import OptimizationFuel ( initOptFuelState )
 import CmmCvt
 import CodeOutput
 import NameEnv          ( emptyNameEnv )
@@ -175,7 +174,6 @@ newHscEnv dflags = do
     nc_var  <- newIORef (initNameCache us knownKeyNames)
     fc_var  <- newIORef emptyUFM
     mlc_var <- newIORef emptyModuleEnv
-    optFuel <- initOptFuelState
     return HscEnv {  hsc_dflags       = dflags,
                      hsc_targets      = [],
                      hsc_mod_graph    = [],
@@ -185,7 +183,6 @@ newHscEnv dflags = do
                      hsc_NC           = nc_var,
                      hsc_FC           = fc_var,
                      hsc_MLC          = mlc_var,
-                     hsc_OptFuel      = optFuel,
                      hsc_type_env_var = Nothing }
 
 
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 156f081d3e..adaa9a3171 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -142,7 +142,6 @@ import Packages hiding  ( Version(..) )
 import DynFlags
 import DriverPhases
 import BasicTypes
-import OptimizationFuel ( OptFuelState )
 import IfaceSyn
 import CoreSyn          ( CoreRule, CoreVect )
 import Maybes
@@ -318,11 +317,6 @@ data HscEnv
                 -- ^ This caches the location of modules, so we don't have to
                 -- search the filesystem multiple times. See also 'hsc_FC'.
 
-        hsc_OptFuel :: OptFuelState,
-                -- ^ Settings to control the use of \"optimization fuel\":
-                -- by limiting the number of transformations,
-                -- we can use binary search to help find compiler bugs.
-
         hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
                 -- ^ Used for one-shot compilation only, to initialise
                 -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for