Remove GHC's haskell98 dependency
[ghc-hetmet.git] / compiler / cmm / CmmSpillReload.hs
index 2b54b9a..c452525 100644 (file)
@@ -1,57 +1,44 @@
 
 module CmmSpillReload
-  ( ExtendWithSpills(..)
-  , DualLive(..)
+  ( DualLive(..)
   , dualLiveLattice, dualLiveTransfers, dualLiveness
   --, insertSpillsAndReloads  --- XXX todo check live-in at entry against formals
   , dualLivenessWithInsertion
-  , elimSpillAndReload
 
   , availRegsLattice
   , cmmAvailableReloads
   , insertLateReloads
-  , insertLateReloads'
   , removeDeadAssignmentsAndReloads
   )
 where
 
+import BlockId
 import CmmExpr
 import CmmTx
 import CmmLiveZ
 import DFMonad
 import MkZipCfg
-import OptimizationFuel
 import PprCmm()
-import StackSlot
 import ZipCfg
 import ZipCfgCmmRep
 import ZipDataflow
 
-import Maybes
-import Monad
+import Control.Monad
 import Outputable hiding (empty)
 import qualified Outputable as PP
-import Panic
 import UniqSet
 
-import Maybe
+import Data.Maybe
 import Prelude hiding (zip)
 
 -- The point of this module is to insert spills and reloads to
 -- establish the invariant that at a call (or at any proc point with
 -- an established protocol) all live variables not expected in
 -- registers are sitting on the stack.  We use a backward analysis to
--- insert spills and reloads.  It should some day be followed by a
+-- insert spills and reloads.  It should be followed by a
 -- forward transformation to sink reloads as deeply as possible, so as
 -- to reduce register pressure.
 
-data ExtendWithSpills m
-    = NotSpillOrReload m
-    | Spill  RegSet
-    | Reload RegSet
-
-type M = ExtendWithSpills Middle
-
 -- A variable can be expected to be live in a register, live on the
 -- stack, or both.  This analysis ensures that spills and reloads are
 -- inserted as needed to make sure that every live variable needed
@@ -70,9 +57,9 @@ dualUnionList ls = DualLive ss rs
     where ss = unionManyUniqSets $ map on_stack ls
           rs = unionManyUniqSets $ map in_regs  ls
 
-_changeStack, changeRegs :: (RegSet -> RegSet) -> DualLive -> DualLive
-_changeStack f live = live { on_stack = f (on_stack live) }
-changeRegs   f live = live { in_regs  = f (in_regs  live) }
+changeStack, changeRegs :: (RegSet -> RegSet) -> DualLive -> DualLive
+changeStack f live = live { on_stack = f (on_stack live) }
+changeRegs  f live = live { in_regs  = f (in_regs  live) }
 
 
 dualLiveLattice :: DataflowLattice DualLive
@@ -85,139 +72,108 @@ dualLiveLattice =
                            return $ DualLive stack regs
           add1 = fact_add_to liveLattice
 
-type LiveReloadFix a = FuelMonad (BackwardFixedPoint M Last DualLive a)
+type LiveReloadFix a = FuelMonad (BackwardFixedPoint Middle Last DualLive a)
 
-dualLivenessWithInsertion :: BlockSet -> (Graph M Last) -> FuelMonad (Graph M Last)
-dualLivenessWithInsertion procPoints g =
-  liftM zdfFpContents $ (res :: LiveReloadFix (Graph M Last))
-    where res = zdfRewriteFrom RewriteDeep emptyBlockEnv "dual liveness with insertion"
-                               dualLiveLattice (dualLiveTransfers procPoints)
-                               (insertSpillAndReloadRewrites procPoints) empty g
+dualLivenessWithInsertion :: BlockSet -> (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+dualLivenessWithInsertion procPoints g@(LGraph entry _) =
+  liftM zdfFpContents $ (res :: LiveReloadFix (LGraph Middle Last))
+    where res = zdfBRewriteFromL RewriteDeep emptyBlockEnv "dual liveness with insertion"
+                                 dualLiveLattice (dualLiveTransfers entry procPoints)
+                                 (insertSpillAndReloadRewrites entry procPoints) empty g
           empty = fact_bot dualLiveLattice
--- = a_ft_b_unlimited dualLiveness insertSpillsAndReloads
 
-dualLiveness :: BlockSet -> Graph M Last -> FuelMonad (BlockEnv DualLive)
-dualLiveness procPoints g = liftM zdfFpFacts $ (res :: LiveReloadFix ())
-    where res = zdfSolveFrom emptyBlockEnv "dual liveness" dualLiveLattice
-                             (dualLiveTransfers procPoints) empty g
+dualLiveness :: BlockSet -> LGraph Middle Last -> FuelMonad (BlockEnv DualLive)
+dualLiveness procPoints g@(LGraph entry _) =
+  liftM zdfFpFacts $ (res :: LiveReloadFix ())
+    where res = zdfSolveFromL emptyBlockEnv "dual liveness" dualLiveLattice
+                              (dualLiveTransfers entry procPoints) empty g
           empty = fact_bot dualLiveLattice
 
-dualLiveTransfers :: BlockSet -> BackwardTransfers M Last DualLive
-dualLiveTransfers procPoints = BackwardTransfers first middle last
+dualLiveTransfers :: BlockId -> BlockSet -> BackwardTransfers Middle Last DualLive
+dualLiveTransfers entry procPoints = BackwardTransfers first middle last
     where last   = lastDualLiveness
           middle = middleDualLiveness
-          first live _id =
-            if elemBlockSet _id procPoints then -- live at procPoint => spill
+          first id live = check live id $  -- live at procPoint => spill
+            if id /= entry && elemBlockSet id procPoints then
               DualLive { on_stack = on_stack live `plusRegSet` in_regs live
                        , in_regs  = emptyRegSet }
             else live
+          check live id x = if id == entry then noLiveOnEntry id (in_regs live) x else x
   
-
-middleDualLiveness :: DualLive -> M -> DualLive
-middleDualLiveness live (Spill regs) = live'
-    -- live-in on-stack requirements are satisfied;
-    -- live-out in-regs obligations are created
-    where live' = DualLive { on_stack = on_stack live `minusRegSet` regs
-                           , in_regs  = in_regs  live `plusRegSet`  regs }
-
-middleDualLiveness live (Reload regs) = live'
-    -- live-in in-regs requirements are satisfied;
-    -- live-out on-stack obligations are created
-    where live' = DualLive { on_stack = on_stack live `plusRegSet`  regs
-                           , in_regs  = in_regs  live `minusRegSet` regs }
-
-middleDualLiveness live (NotSpillOrReload m) = changeRegs (middleLiveness m) live
-
-lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
-lastDualLiveness env l = last l
-  where last (LastReturn)            = empty
-        last (LastJump e)            = changeRegs (gen e) empty
-        last (LastBranch id)         = env id
-        last (LastCall tgt Nothing)  = changeRegs (gen tgt) empty
-        last (LastCall tgt (Just k)) = 
-            -- nothing can be live in registers at this point
-            let live = env k in
-            if  isEmptyUniqSet (in_regs live) then
-                DualLive (on_stack live) (gen tgt emptyRegSet)
-            else
-                pprTrace "Offending party:" (ppr k <+> ppr live) $
-                panic "live values in registers at call continuation"
-        last (LastCondBranch e t f) = changeRegs (gen e) $ dualUnion (env t) (env f)
-        last (LastSwitch e tbl)     = changeRegs (gen e) $ dualUnionList $
+middleDualLiveness :: Middle -> DualLive -> DualLive
+middleDualLiveness m live =
+  changeStack updSlots $ changeRegs (middleLiveness m) (changeRegs regs_in live)
+    where regs_in live = case m of MidForeignCall {} -> emptyRegSet
+                                   _ -> live
+          updSlots live = foldSlotsUsed reload (foldSlotsDefd spill live m) m
+          spill  live s@(RegSlot r, _, _) = check s $ deleteFromRegSet live r
+          spill  live _ = live
+          reload live s@(RegSlot r, _, _) = check s $ extendRegSet live r
+          reload live _ = live
+          check (RegSlot (LocalReg _ ty), o, w) x
+             | o == w && w == widthInBytes (typeWidth ty) = x
+          check _ _ = panic "middleDualLiveness unsupported: slices"
+
+lastDualLiveness :: Last -> (BlockId -> DualLive) -> DualLive
+lastDualLiveness l env = last l
+  where last (LastBranch id)          = env id
+        last l@(LastCall _ Nothing  _ _ _) = changeRegs (gen l . kill l) empty
+        last l@(LastCall _ (Just k) _ _ _) = 
+            -- nothing can be live in registers at this point, unless safe foreign call
+            let live = env k
+                live_in = DualLive (on_stack live) (gen l emptyRegSet)
+            in if isEmptyUniqSet (in_regs live) then live_in
+               else pprTrace "Offending party:" (ppr k <+> ppr live) $
+                    panic "live values in registers at call continuation"
+        last l@(LastCondBranch _ t f)   =
+            changeRegs (gen l . kill l) $ dualUnion (env t) (env f)
+        last l@(LastSwitch _ tbl)       = changeRegs (gen l . kill l) $ dualUnionList $
                                                              map env (catMaybes tbl)
         empty = fact_bot dualLiveLattice
                       
-gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
-gen  a live = foldRegsUsed extendRegSet      live a
-kill a live = foldRegsUsed delOneFromUniqSet live a
-
-insertSpillAndReloadRewrites :: BlockSet -> BackwardRewrites M Last DualLive Graph
-insertSpillAndReloadRewrites procPoints = BackwardRewrites first middle last exit
+gen  :: UserOfLocalRegs    a => a -> RegSet -> RegSet
+gen  a live = foldRegsUsed extendRegSet     live a
+kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
+kill a live = foldRegsDefd deleteFromRegSet live a
+
+insertSpillAndReloadRewrites ::
+  BlockId -> BlockSet -> BackwardRewrites Middle Last DualLive
+insertSpillAndReloadRewrites entry procPoints =
+  BackwardRewrites first middle last exit
     where middle = middleInsertSpillsAndReloads
-          last   = \_ _ -> Nothing
-          exit = Nothing
-          first live id =
-            if elemBlockSet id procPoints && not (isEmptyUniqSet reloads) then
-              Just $ graphOfMiddles $ [Reload reloads]
+          last _ _ = Nothing
+          exit     = Nothing
+          first id live =
+            if id /= entry && elemBlockSet id procPoints then
+              case map reload (uniqSetToList (in_regs live)) of
+                [] -> Nothing
+                is -> Just (mkMiddles is)
             else Nothing
-              where reloads = in_regs live
-
 
-middleInsertSpillsAndReloads :: DualLive -> M -> Maybe (Graph M Last)
-middleInsertSpillsAndReloads _ (Spill _)  = Nothing
-middleInsertSpillsAndReloads _ (Reload _) = Nothing
-middleInsertSpillsAndReloads live m@(NotSpillOrReload nsr) = middle nsr
-  where middle (MidAssign (CmmLocal reg) _) = 
+middleInsertSpillsAndReloads :: Middle -> DualLive -> Maybe (AGraph Middle Last)
+middleInsertSpillsAndReloads m live = middle m
+  where middle (MidAssign (CmmLocal reg) (CmmLoad (CmmStackSlot (RegSlot reg') _) _))
+          | reg == reg' = Nothing
+        middle (MidAssign (CmmLocal reg) _) = 
             if reg `elemRegSet` on_stack live then -- must spill
-                my_trace "Spilling" (f4sep [text "spill" <+> ppr reg,
-                                            text "after", ppr m]) $
-                Just $ graphOfMiddles [m, Spill $ mkRegSet [reg]]
-            else
-                Nothing
-        middle (CopyIn _ formals _) = 
-            -- only 'formals' can be in regs at this point
-            let regs' = kill formals (in_regs live) -- live in regs; must reload
-                is_stack_var r = elemRegSet r (on_stack live)
-                needs_spilling = filterRegsUsed is_stack_var formals
-                   -- a formal that is expected on the stack; must spill
-            in  if isEmptyUniqSet regs' && isEmptyUniqSet needs_spilling then
-                    Nothing
-                else
-                    let code  = if isEmptyUniqSet regs' then []
-                                else Reload regs' : []
-                        code' = if isEmptyUniqSet needs_spilling then code
-                                else Spill needs_spilling : code
-                    in
-                    my_trace "At CopyIn" (f4sep [text "Triggered by ", ppr live,
-                                                 ppr (Reload regs' :: M),
-                                                 ppr (Spill needs_spilling :: M),
-                                                 text "after", ppr m]) $
-                    Just $ graphOfMiddles (m : code')
+                 my_trace "Spilling" (f4sep [text "spill" <+> ppr reg,
+                                             text "after", ppr m]) $
+                 Just $ mkMiddles $ [m, spill reg]
+            else Nothing
+        middle (MidForeignCall _ _ fs _) =
+          case map spill  (filter (flip elemRegSet (on_stack live)) fs) ++
+               map reload (uniqSetToList (kill fs (in_regs live))) of
+            []      -> Nothing
+            reloads -> Just (mkMiddles (m : reloads))
         middle _ = Nothing
                       
--- | For conversion back to vanilla C--
-
-elimSpillAndReload :: StackSlotMap -> LGraph M l -> FuelMonad (StackSlotMap, LGraph Middle l)
-elimSpillAndReload slots g = fold_blocks block (return (slots, [])) g >>= toGraph
-  where toGraph (slots, l) = return (slots, of_block_list (lg_entry g) l)
-        block (Block id t) z =
-          do (slots, blocks) <- z
-             (slots, t)      <- tail t slots
-             return (slots, Block id t : blocks)
-        tail (ZLast l)   slots = return (slots, ZLast l)
-        tail (ZTail m t) slots =
-          do (slots, t) <- tail t slots
-             middle m t slots
-        middle (Spill  regs) t slots = foldUniqSet spill  (return (slots, t)) regs
-        middle (Reload regs) t slots = foldUniqSet reload (return (slots, t)) regs
-        middle (NotSpillOrReload m) t slots = return (slots, ZTail m t)
-        move f r z = do let reg = CmmLocal r
-                        (slots, t) <- z
-                        (slots, slot) <- getSlot slots reg
-                        return (slots, ZTail (f (CmmStack slot) reg) t)
-        spill  = move (\ slot reg -> MidAssign slot (CmmReg reg))
-        reload = move (\ slot reg -> MidAssign reg  (CmmReg slot))
+-- Generating spill and reload code
+regSlot :: LocalReg -> CmmExpr
+regSlot r = CmmStackSlot (RegSlot r) (widthInBytes $ typeWidth $ localRegType r)
 
+spill, reload :: LocalReg -> Middle
+spill  r = MidStore  (regSlot r) (CmmReg $ CmmLocal r)
+reload r = MidAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
 
 ----------------------------------------------------------------
 --- sinking reloads
@@ -234,7 +190,6 @@ data AvailRegs = UniverseMinus RegSet
 
 availRegsLattice :: DataflowLattice AvailRegs
 availRegsLattice = DataflowLattice "register gotten from reloads" empty add False
-                            -- last True <==> debugging on
     where empty = UniverseMinus emptyRegSet
           -- | compute in the Tx monad to track whether anything has changed
           add new old =
@@ -258,138 +213,81 @@ extendAvail :: AvailRegs -> LocalReg -> AvailRegs
 extendAvail (UniverseMinus s) r = UniverseMinus (deleteFromRegSet s r)
 extendAvail (AvailRegs     s) r = AvailRegs (extendRegSet s r)
 
-deleteFromAvail :: AvailRegs -> LocalReg -> AvailRegs
-deleteFromAvail (UniverseMinus s) r = UniverseMinus (extendRegSet s r)
-deleteFromAvail (AvailRegs     s) r = AvailRegs (deleteFromRegSet s r)
+delFromAvail :: AvailRegs -> LocalReg -> AvailRegs
+delFromAvail (UniverseMinus s) r = UniverseMinus (extendRegSet s r)
+delFromAvail (AvailRegs     s) r = AvailRegs (deleteFromRegSet s r)
 
 elemAvail :: AvailRegs -> LocalReg -> Bool
 elemAvail (UniverseMinus s) r = not $ elemRegSet r s
 elemAvail (AvailRegs     s) r = elemRegSet r s
 
-type CmmAvail = BlockEnv AvailRegs
-type AvailFix = FuelMonad (ForwardFixedPoint M Last AvailRegs ())
+type AvailFix = FuelMonad (ForwardFixedPoint Middle Last AvailRegs ())
 
-cmmAvailableReloads :: Graph M Last -> FuelMonad CmmAvail
+cmmAvailableReloads :: LGraph Middle Last -> FuelMonad (BlockEnv AvailRegs)
 cmmAvailableReloads g = liftM zdfFpFacts $ (res :: AvailFix)
-    where res = zdfSolveFrom emptyBlockEnv "available reloads" availRegsLattice
-                             avail_reloads_transfer empty g
-          empty = (fact_bot availRegsLattice)
-
-avail_reloads_transfer :: ForwardTransfers M Last AvailRegs
-avail_reloads_transfer = ForwardTransfers first middle last id
-  where first avail _ = avail
-        middle        = flip middleAvail
-        last          = lastAvail
-
--- | The transfer equations use the traditional 'gen' and 'kill'
--- notations, which should be familiar from the dragon book.
-agen, akill :: UserOfLocalRegs a => a -> AvailRegs -> AvailRegs
-agen  a live = foldRegsUsed extendAvail     live a
-akill a live = foldRegsUsed deleteFromAvail live a
-
--- Note: you can't sink the reload past a use.
-middleAvail :: M -> AvailRegs -> AvailRegs
-middleAvail (Spill _) = id
-middleAvail (Reload regs) = agen regs
-middleAvail (NotSpillOrReload m) = middle m
-  where middle m live = middle' m $ foldRegsUsed deleteFromAvail live m
-        middle' (MidComment {})                 = id
-        middle' (MidAssign lhs _expr)           = akill lhs
-        middle' (MidStore {})                   = id
-        middle' (MidUnsafeCall _tgt ress _args) = akill ress
-        middle' (MidAddToContext {})            = id
-        middle' (CopyIn _ formals _)            = akill formals
-        middle' (CopyOut {})                    = id
-
-lastAvail :: AvailRegs -> Last -> LastOutFacts AvailRegs
-lastAvail _ (LastCall _ (Just k)) = LastOutFacts [(k, AvailRegs emptyRegSet)]
-lastAvail avail l = LastOutFacts $ map (\id -> (id, avail)) $ succs l
-
-insertLateReloads :: Graph M Last -> FuelMonad (Graph M Last)
-insertLateReloads g =
-  do env <- cmmAvailableReloads g
-     g   <- lGraphOfGraph g
-     liftM graphOfLGraph $ mapM_blocks (insertM env) g
-    where insertM env b = fuelConsumingPass "late reloads" (insert b)
-            where avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
-                  insert (Block id tail) fuel = propagate (ZFirst id) (avail id) tail fuel
-                  propagate h avail (ZTail m t) fuel =
-                      let (h', fuel') = maybe_add_reload h avail m fuel in
-                      propagate (ZHead h' m) (middleAvail m avail) t fuel'
-                  propagate h avail (ZLast l) fuel =
-                      let (h', fuel') = maybe_add_reload h avail l fuel in
-                      (zipht h' (ZLast l), fuel')
-                  maybe_add_reload h avail node fuel =
-                      let used = filterRegsUsed (elemAvail avail) node
-                      in  if not (canRewriteWithFuel fuel) || isEmptyUniqSet used
-                          then (h,fuel)
-                          else (ZHead h (Reload used), oneLessFuel fuel)
-
-type LateReloadFix = FuelMonad (ForwardFixedPoint M Last AvailRegs (Graph M Last))
-
-insertLateReloads' :: (Graph M Last) -> FuelMonad (Graph M Last)
-insertLateReloads' g = liftM zdfFpContents $ (res :: LateReloadFix)
-    where res = zdfRewriteFrom RewriteShallow emptyBlockEnv "insert late reloads"
-                               availRegsLattice avail_reloads_transfer rewrites bot g
+    where res = zdfSolveFromL emptyBlockEnv "available reloads" availRegsLattice
+                              avail_reloads_transfer empty g
+          empty = fact_bot availRegsLattice
+
+avail_reloads_transfer :: ForwardTransfers Middle Last AvailRegs
+avail_reloads_transfer = ForwardTransfers (flip const) middleAvail lastAvail id
+
+middleAvail :: Middle -> AvailRegs -> AvailRegs
+middleAvail (MidAssign (CmmLocal r) (CmmLoad l _)) avail
+               | l `isStackSlotOf` r = extendAvail avail r
+middleAvail (MidAssign lhs _)        avail = foldRegsDefd delFromAvail avail lhs
+middleAvail (MidStore l (CmmReg (CmmLocal r))) avail
+               | l `isStackSlotOf` r = avail
+middleAvail (MidStore (CmmStackSlot (RegSlot r) _) _) avail = delFromAvail avail r
+middleAvail (MidStore {})            avail = avail
+middleAvail (MidForeignCall {})      _     = AvailRegs emptyRegSet
+middleAvail (MidComment {})          avail = avail
+
+lastAvail :: Last -> AvailRegs -> LastOutFacts AvailRegs
+lastAvail (LastCall _ (Just k) _ _ _) _ = LastOutFacts [(k, AvailRegs emptyRegSet)]
+lastAvail l avail = LastOutFacts $ map (\id -> (id, avail)) $ succs l
+
+type LateReloadFix = FuelMonad (ForwardFixedPoint Middle Last AvailRegs CmmGraph)
+
+availRewrites :: ForwardRewrites Middle Last AvailRegs
+availRewrites = ForwardRewrites first middle last exit
+  where first _ _ = Nothing
+        middle m avail = maybe_reload_before avail m (mkMiddle m)
+        last   l avail = maybe_reload_before avail l (mkLast l)
+        exit _ = Nothing
+        maybe_reload_before avail node tail =
+            let used = filterRegsUsed (elemAvail avail) node
+            in  if isEmptyUniqSet used then Nothing
+                else Just $ reloadTail used tail
+        reloadTail regset t = foldl rel t $ uniqSetToList regset
+          where rel t r = mkMiddle (reload r) <*> t
+
+
+insertLateReloads :: (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+insertLateReloads g = liftM zdfFpContents $ (res :: LateReloadFix)
+    where res = zdfFRewriteFromL RewriteShallow emptyBlockEnv "insert late reloads"
+                                 availRegsLattice avail_reloads_transfer availRewrites bot g
           bot = fact_bot availRegsLattice
-          rewrites = ForwardRewrites first middle last exit
-          first _ _ = Nothing
-          middle :: AvailRegs -> M -> Maybe (Graph M Last)
-          last   :: AvailRegs -> Last -> Maybe (Graph M Last)
-          middle avail m = maybe_reload_before avail m (ZTail m (ZLast LastExit))
-          last avail l   = maybe_reload_before avail l (ZLast (LastOther l))
-          exit _ = Nothing
-          maybe_reload_before avail node tail =
-              let used = filterRegsUsed (elemAvail avail) node
-              in  if isEmptyUniqSet used then Nothing
-                  else Just $ graphOfZTail $ ZTail (Reload used) tail
           
-removeDeadAssignmentsAndReloads :: BlockSet -> (Graph M Last) -> FuelMonad (Graph M Last)
-removeDeadAssignmentsAndReloads procPoints g =
-   liftM zdfFpContents $ (res :: LiveReloadFix (Graph M Last))
-     where res = zdfRewriteFrom RewriteDeep emptyBlockEnv "dead-assignment & -reload elim"
-                   dualLiveLattice (dualLiveTransfers procPoints)
+removeDeadAssignmentsAndReloads :: BlockSet -> (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+removeDeadAssignmentsAndReloads procPoints g@(LGraph entry _) =
+   liftM zdfFpContents $ (res :: LiveReloadFix (LGraph Middle Last))
+     where res = zdfBRewriteFromL RewriteDeep emptyBlockEnv "dead-assignment & -reload elim"
+                   dualLiveLattice (dualLiveTransfers entry procPoints)
                    rewrites (fact_bot dualLiveLattice) g
-           rewrites = BackwardRewrites first middle last exit
-           exit   = Nothing
-           last   = \_ _ -> Nothing
-           middle = middleRemoveDeads
-           first _ _ = Nothing
-
-middleRemoveDeads :: DualLive -> M -> Maybe (Graph M Last)
-middleRemoveDeads _ (Spill _)  = Nothing
-middleRemoveDeads live (Reload s) =
-    if sizeUniqSet worth_reloading < sizeUniqSet s then
-        Just $ if isEmptyUniqSet worth_reloading then emptyGraph
-               else graphOfMiddles [Reload worth_reloading]
-    else
-        Nothing
-  where worth_reloading = intersectUniqSets s (in_regs live)
-middleRemoveDeads live (NotSpillOrReload m) = middle m 
-  where middle (MidAssign (CmmLocal reg') _)
-               | not (reg' `elemRegSet` in_regs live) = Just emptyGraph
-        middle _ = Nothing
-                      
-
+           rewrites = BackwardRewrites nothing middleRemoveDeads nothing Nothing
+           nothing _ _ = Nothing
 
----------------------
--- register usage
+middleRemoveDeads :: Middle -> DualLive -> Maybe (AGraph Middle Last)
+middleRemoveDeads  (MidAssign (CmmLocal reg') _) live
+       | not (reg' `elemRegSet` in_regs live) = Just emptyAGraph
+middleRemoveDeads  _ _ = Nothing
+                      
 
-instance UserOfLocalRegs m => UserOfLocalRegs (ExtendWithSpills m) where
-    foldRegsUsed  f z (Spill  regs) = foldRegsUsed f z regs
-    foldRegsUsed _f z (Reload _)    = z
-    foldRegsUsed  f z (NotSpillOrReload m) = foldRegsUsed f z m
 
 ---------------------
 -- prettyprinting
 
-instance Outputable m => Outputable (ExtendWithSpills m) where
-    ppr (Spill  regs) = ppr_regs "Spill"  regs
-    ppr (Reload regs) = ppr_regs "Reload" regs
-    ppr (NotSpillOrReload m) = ppr m
-
-instance Outputable m => DebugNodes (ExtendWithSpills m) Last
-                               
 ppr_regs :: String -> RegSet -> SDoc
 ppr_regs s regs = text s <+> commafy (map ppr $ uniqSetToList regs)
   where commafy xs = hsep $ punctuate comma xs