Generalize register sets and liveness calculations.

We would like to calculate register liveness for global registers as well as
local registers, so this patch generalizes the existing infrastructure to set
the stage.

8 files changed, 267 insertions, 167 deletions

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 128eb1ca62..87713c6b0d 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -1,16 +1,24 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module CmmExpr
     ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
     , CmmReg(..), cmmRegType
     , CmmLit(..), cmmLitType
     , LocalReg(..), localRegType
-    , GlobalReg(..), globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
+    , GlobalReg(..), isArgReg, globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
     , VGcPtr(..), vgcFlag       -- Temporary!
-    , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
-    , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
-            , regSetToList
+
+    , DefinerOfRegs, UserOfRegs
+    , foldRegsDefd, foldRegsUsed, filterRegsUsed
+    , foldLocalRegsDefd, foldLocalRegsUsed
+
+    , RegSet, LocalRegSet, GlobalRegSet
+    , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
+    , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
+    , regSetToList
     , regUsedIn
+    
     , Area(..)
     , module CmmMachOp
     , module CmmType
@@ -177,7 +185,7 @@ localRegType (LocalReg _ rep) = rep
 --    Register-use information for expressions and other types
 -----------------------------------------------------------------------------
 
--- | Sets of local registers
+-- | Sets of registers
 
 -- These are used for dataflow facts, and a common operation is taking
 -- the union of two RegSets and then asking whether the union is the
@@ -185,16 +193,19 @@ localRegType (LocalReg _ rep) = rep
 -- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
 -- Sets.
 
-type RegSet              =  Set LocalReg
-emptyRegSet             :: RegSet
-nullRegSet              :: RegSet -> Bool
-elemRegSet              :: LocalReg -> RegSet -> Bool
-extendRegSet            :: RegSet -> LocalReg -> RegSet
-deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
-mkRegSet                :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
-sizeRegSet              :: RegSet -> Int
-regSetToList            :: RegSet -> [LocalReg]
+type RegSet r     = Set r
+type LocalRegSet  = RegSet LocalReg
+type GlobalRegSet = RegSet GlobalReg
+
+emptyRegSet             :: Ord r => RegSet r
+nullRegSet              :: Ord r => RegSet r -> Bool
+elemRegSet              :: Ord r => r -> RegSet r -> Bool
+extendRegSet            :: Ord r => RegSet r -> r -> RegSet r
+deleteFromRegSet        :: Ord r => RegSet r -> r -> RegSet r
+mkRegSet                :: Ord r => [r] -> RegSet r
+minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
+sizeRegSet              :: Ord r => RegSet r -> Int
+regSetToList            :: Ord r => RegSet r -> [r]
 
 emptyRegSet      = Set.empty
 nullRegSet       = Set.null
@@ -208,58 +219,75 @@ timesRegSet      = Set.intersection
 sizeRegSet       = Set.size
 regSetToList     = Set.toList
 
-class UserOfLocalRegs a where
-  foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
+class Ord r => UserOfRegs r a where
+  foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
+
+foldLocalRegsUsed :: UserOfRegs LocalReg a
+                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsUsed = foldRegsUsed
 
-class DefinerOfLocalRegs a where
-  foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
+class Ord r => DefinerOfRegs r a where
+  foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b
 
-filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
-filterRegsUsed p e =
-    foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+foldLocalRegsDefd :: DefinerOfRegs LocalReg a
+                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
+foldLocalRegsDefd = foldRegsDefd
+
+filterRegsUsed :: UserOfRegs r e => DynFlags -> (r -> Bool) -> e -> RegSet r
+filterRegsUsed dflags p e =
+    foldRegsUsed dflags
+                 (\regs r -> if p r then extendRegSet regs r else regs)
                  emptyRegSet e
 
-instance UserOfLocalRegs a => UserOfLocalRegs (Maybe a) where
-    foldRegsUsed f z (Just x) = foldRegsUsed f z x
-    foldRegsUsed _ z Nothing = z
+instance UserOfRegs LocalReg CmmReg where
+    foldRegsUsed _ f z (CmmLocal reg) = f z reg
+    foldRegsUsed _ _ z (CmmGlobal _)  = z
+
+instance DefinerOfRegs LocalReg CmmReg where
+    foldRegsDefd _ f z (CmmLocal reg) = f z reg
+    foldRegsDefd _ _ z (CmmGlobal _)  = z
 
-instance UserOfLocalRegs CmmReg where
-    foldRegsUsed f z (CmmLocal reg) = f z reg
-    foldRegsUsed _ z (CmmGlobal _)  = z
+instance UserOfRegs GlobalReg CmmReg where
+    foldRegsUsed _ _ z (CmmLocal _)    = z
+    foldRegsUsed _ f z (CmmGlobal reg) = f z reg
 
-instance DefinerOfLocalRegs CmmReg where
-    foldRegsDefd f z (CmmLocal reg) = f z reg
-    foldRegsDefd _ z (CmmGlobal _)  = z
+instance DefinerOfRegs GlobalReg CmmReg where
+    foldRegsDefd _ _ z (CmmLocal _)    = z
+    foldRegsDefd _ f z (CmmGlobal reg) = f z reg
 
-instance UserOfLocalRegs LocalReg where
-    foldRegsUsed f z r = f z r
+instance Ord r => UserOfRegs r r where
+    foldRegsUsed _ f z r = f z r
 
-instance DefinerOfLocalRegs LocalReg where
-    foldRegsDefd f z r = f z r
+instance Ord r => DefinerOfRegs r r where
+    foldRegsDefd _ f z r = f z r
 
-instance UserOfLocalRegs RegSet where
-    foldRegsUsed f = Set.fold (flip f)
+instance Ord r => UserOfRegs r (RegSet r) where
+    foldRegsUsed _ f = Set.fold (flip f)
 
-instance UserOfLocalRegs CmmExpr where
-  foldRegsUsed f z e = expr z e
+instance UserOfRegs r CmmReg => UserOfRegs r CmmExpr where
+  foldRegsUsed dflags f z e = expr z e
     where expr z (CmmLit _)          = z
-          expr z (CmmLoad addr _)    = foldRegsUsed f z addr
-          expr z (CmmReg r)          = foldRegsUsed f z r
-          expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
-          expr z (CmmRegOff r _)     = foldRegsUsed f z r
+          expr z (CmmLoad addr _)    = foldRegsUsed dflags f z addr
+          expr z (CmmReg r)          = foldRegsUsed dflags f z r
+          expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
+          expr z (CmmRegOff r _)     = foldRegsUsed dflags f z r
           expr z (CmmStackSlot _ _)  = z
 
-instance UserOfLocalRegs a => UserOfLocalRegs [a] where
-  foldRegsUsed _ set [] = set
-  foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
+instance UserOfRegs r a => UserOfRegs r (Maybe a) where
+    foldRegsUsed dflags f z (Just x) = foldRegsUsed dflags f z x
+    foldRegsUsed _      _ z Nothing = z
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
-  foldRegsDefd _ set [] = set
-  foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
+instance UserOfRegs r a => UserOfRegs r [a] where
+  foldRegsUsed _      _ set [] = set
+  foldRegsUsed dflags f set (x:xs) = foldRegsUsed dflags f (foldRegsUsed dflags f set x) xs
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
-  foldRegsDefd _ set Nothing  = set
-  foldRegsDefd f set (Just x) = foldRegsDefd f set x
+instance DefinerOfRegs r a => DefinerOfRegs r [a] where
+  foldRegsDefd _      _ set [] = set
+  foldRegsDefd dflags f set (x:xs) = foldRegsDefd dflags f (foldRegsDefd dflags f set x) xs
+
+instance DefinerOfRegs r a => DefinerOfRegs r (Maybe a) where
+  foldRegsDefd _      _ set Nothing  = set
+  foldRegsDefd dflags f set (Just x) = foldRegsDefd dflags f set x
 
 -----------------------------------------------------------------------------
 -- Another reg utility
@@ -424,3 +452,10 @@ globalRegType dflags Hp                = gcWord dflags
                                             -- The initialiser for all
                                             -- dynamically allocated closures
 globalRegType dflags _                 = bWord dflags
+
+isArgReg :: GlobalReg -> Bool
+isArgReg (VanillaReg {}) = True
+isArgReg (FloatReg {})   = True
+isArgReg (DoubleReg {})  = True
+isArgReg (LongReg {})    = True
+isArgReg _               = False
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index de9f35a798..c7e6e3ae6e 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -111,9 +111,9 @@ cmmLayoutStack dflags procpoints entry_args
 
     -- We need liveness info.  We could do removeDeadAssignments at
     -- the same time, but it buys nothing over doing cmmSink later,
-    -- and costs a lot more than just cmmLiveness.
+    -- and costs a lot more than just cmmLocalLiveness.
     -- (graph, liveness) <- removeDeadAssignments graph0
-    let (graph, liveness) = (graph0, cmmLiveness graph0)
+    let (graph, liveness) = (graph0, cmmLocalLiveness dflags graph0)
 
     -- pprTrace "liveness" (ppr liveness) $ return ()
     let blocks = postorderDfs graph
@@ -132,7 +132,7 @@ cmmLayoutStack dflags procpoints entry_args
 
 layout :: DynFlags
        -> BlockSet                      -- proc points
-       -> BlockEnv CmmLive              -- liveness
+       -> BlockEnv CmmLocalLive         -- liveness
        -> BlockId                       -- entry
        -> ByteOff                       -- stack args on entry
 
@@ -319,7 +319,7 @@ getStackLoc (Young l) n stackmaps =
 -- extra code that goes *after* the Sp adjustment.
 
 handleLastNode
-   :: DynFlags -> ProcPointSet -> BlockEnv CmmLive -> BlockEnv ByteOff
+   :: DynFlags -> ProcPointSet -> BlockEnv CmmLocalLive -> BlockEnv ByteOff
    -> BlockEnv StackMap -> StackMap
    -> Block CmmNode O O
    -> CmmNode O C
@@ -499,7 +499,7 @@ fixupStack old_stack new_stack = concatMap move new_locs
 setupStackFrame
              :: DynFlags
              -> BlockId                 -- label of continuation
-             -> BlockEnv CmmLive        -- liveness
+             -> BlockEnv CmmLocalLive   -- liveness
              -> ByteOff      -- updfr
              -> ByteOff      -- bytes of return values on stack
              -> StackMap     -- current StackMap
@@ -602,7 +602,7 @@ futureContinuation middle = foldBlockNodesB f middle Nothing
 -- on the stack and return the new StackMap and the assignments to do
 -- the saving.
 --
-allocate :: DynFlags -> ByteOff -> RegSet -> StackMap
+allocate :: DynFlags -> ByteOff -> LocalRegSet -> StackMap
          -> (StackMap, [CmmNode O O])
 allocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0
                                               , sm_regs = regs0 }
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 87a3ebfb5e..da7b094643 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -32,10 +32,10 @@ import Data.Maybe
 
 cmmLint :: (Outputable d, Outputable h)
         => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc
-cmmLint dflags tops = runCmmLint dflags (mapM_ lintCmmDecl) tops
+cmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops
 
 cmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc
-cmmLintGraph dflags g = runCmmLint dflags lintCmmGraph g
+cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g
 
 runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc
 runCmmLint dflags l p =
@@ -46,18 +46,19 @@ runCmmLint dflags l p =
                              nest 2 (ppr p)])
      Right _  -> Nothing
 
-lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint ()
-lintCmmDecl (CmmProc _ lbl g)
-  = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g
-lintCmmDecl (CmmData {})
+lintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint ()
+lintCmmDecl dflags (CmmProc _ lbl _ g)
+  = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph dflags g
+lintCmmDecl _ (CmmData {})
   = return ()
 
 
-lintCmmGraph :: CmmGraph -> CmmLint ()
-lintCmmGraph g = cmmLiveness g `seq` mapM_ (lintCmmBlock labels) blocks
-                 -- cmmLiveness throws an error if there are registers
-                 -- live on entry to the graph (i.e. undefined
-                 -- variables)
+lintCmmGraph :: DynFlags -> CmmGraph -> CmmLint ()
+lintCmmGraph dflags g =
+    cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks
+    -- cmmLiveness throws an error if there are registers
+    -- live on entry to the graph (i.e. undefined
+    -- variables)
   where
        blocks = toBlockList g
        labels = setFromList (map entryLabel blocks)
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index f0163fefc4..7d674b76a2 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,10 +1,14 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 module CmmLive
-    ( CmmLive
-    , cmmLiveness
+    ( CmmLocalLive
+    , CmmGlobalLive
+    , cmmLocalLiveness
+    , cmmGlobalLiveness
     , liveLattice
     , noLiveOnEntry, xferLive, gen, kill, gen_kill
     , removeDeadAssignments
@@ -12,6 +16,7 @@ module CmmLive
 where
 
 import UniqSupply
+import DynFlags
 import BlockId
 import Cmm
 import CmmUtils
@@ -26,10 +31,14 @@ import Outputable
 -----------------------------------------------------------------------------
 
 -- | The variables live on entry to a block
-type CmmLive = RegSet
+type CmmLive r = RegSet r
+type CmmLocalLive = CmmLive LocalReg
+type CmmGlobalLive = CmmLive GlobalReg
 
 -- | The dataflow lattice
-liveLattice :: DataflowLattice CmmLive
+liveLattice :: Ord r => DataflowLattice (CmmLive r)
+{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
+{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
 liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
     where add _ (OldFact old) (NewFact new) =
                (changeIf $ sizeRegSet join > sizeRegSet old, join)
@@ -37,58 +46,73 @@ liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
 
 
 -- | A mapping from block labels to the variables live on entry
-type BlockEntryLiveness = BlockEnv CmmLive
+type BlockEntryLiveness r = BlockEnv (CmmLive r)
 
 -----------------------------------------------------------------------------
 -- | Calculated liveness info for a CmmGraph
 -----------------------------------------------------------------------------
 
-cmmLiveness :: CmmGraph -> BlockEntryLiveness
-cmmLiveness graph =
-  check $ dataflowAnalBwd graph [] $ analBwd liveLattice xferLive
+cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
+cmmLocalLiveness dflags graph =
+  check $ dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)
   where entry = g_entry graph
         check facts = noLiveOnEntry entry
                         (expectJust "check" $ mapLookup entry facts) facts
 
+cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
+cmmGlobalLiveness dflags graph =
+  dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)
+
 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
-noLiveOnEntry :: BlockId -> CmmLive -> a -> a
+noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
 noLiveOnEntry bid in_fact x =
   if nullRegSet in_fact then x
   else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
 
 -- | The transfer equations use the traditional 'gen' and 'kill'
 -- notations, which should be familiar from the Dragon Book.
-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
+gen  :: UserOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
+{-# INLINE gen #-}
+gen dflags a live = foldRegsUsed dflags extendRegSet live a
+
+kill :: DefinerOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
+{-# INLINE kill #-}
+kill dflags a live = foldRegsDefd dflags deleteFromRegSet live a
 
-gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a)
-          => a -> CmmLive -> CmmLive
-gen_kill a = gen a . kill a
+gen_kill :: (DefinerOfRegs r a, UserOfRegs r a)
+          => DynFlags -> a -> CmmLive r -> CmmLive r
+{-# INLINE gen_kill #-}
+gen_kill dflags a = gen dflags a . kill dflags a
 
 -- | The transfer function
-xferLive :: BwdTransfer CmmNode CmmLive
-xferLive = mkBTransfer3 fst mid lst
+xferLive :: forall r . ( UserOfRegs    r (CmmNode O O)
+                       , DefinerOfRegs r (CmmNode O O)
+                       , UserOfRegs    r (CmmNode O C)
+                       , DefinerOfRegs r (CmmNode O C))
+         => DynFlags -> BwdTransfer CmmNode (CmmLive r)
+{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive LocalReg) #-}
+{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive GlobalReg) #-}
+xferLive dflags = mkBTransfer3 fst mid lst
   where fst _ f = f
-        mid :: CmmNode O O -> CmmLive -> CmmLive
-        mid n f = gen_kill n f
-        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
-        lst n f = gen_kill n $ joinOutFacts liveLattice n f
+        mid :: CmmNode O O -> CmmLive r -> CmmLive r
+        mid n f = gen_kill dflags n f
+        lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
+        lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f
 
 -----------------------------------------------------------------------------
 -- Removing assignments to dead variables
 -----------------------------------------------------------------------------
 
-removeDeadAssignments :: CmmGraph -> UniqSM (CmmGraph, BlockEnv CmmLive)
-removeDeadAssignments g =
-   dataflowPassBwd g [] $ analRewBwd liveLattice xferLive rewrites
+removeDeadAssignments :: DynFlags -> CmmGraph
+                      -> UniqSM (CmmGraph, BlockEnv CmmLocalLive)
+removeDeadAssignments dflags g =
+   dataflowPassBwd g [] $ analRewBwd liveLattice (xferLive dflags) rewrites
    where rewrites = mkBRewrite3 nothing middle nothing
          -- SDM: no need for deepBwdRw here, we only rewrite to empty
          -- Beware: deepBwdRw with one polymorphic function seems more
          -- reasonable here, but GHC panics while compiling, see bug
          -- #4045.
-         middle :: CmmNode O O -> Fact O CmmLive -> CmmReplGraph O O
+         middle :: CmmNode O O -> Fact O CmmLocalLive -> CmmReplGraph O O
          middle (CmmAssign (CmmLocal reg') _) live
                  | not (reg' `elemRegSet` live)
                  = return $ Just emptyGraph
@@ -99,5 +123,5 @@ removeDeadAssignments g =
                  = return $ Just emptyGraph
          middle _ _ = return Nothing
 
-         nothing :: CmmNode e x -> Fact x CmmLive -> CmmReplGraph e x
+         nothing :: CmmNode e x -> Fact x CmmLocalLive -> CmmReplGraph e x
          nothing _ _ = return Nothing
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index b7bb270bd6..6fa3007fbe 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -1,5 +1,7 @@
 -- CmmNode type for representation using Hoopl graphs.
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
@@ -16,7 +18,9 @@ module CmmNode (
      mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors
   ) where
 
+import CodeGen.Platform
 import CmmExpr
+import DynFlags
 import FastString
 import ForeignCall
 import SMRep
@@ -280,8 +284,8 @@ data ForeignTarget        -- The target of a foreign call
 --------------------------------------------------
 -- Instances of register and slot users / definers
 
-instance UserOfLocalRegs (CmmNode e x) where
-  foldRegsUsed f z n = case n of
+instance UserOfRegs LocalReg (CmmNode e x) where
+  foldRegsUsed dflags f z n = case n of
     CmmAssign _ expr -> fold f z expr
     CmmStore addr rval -> fold f (fold f z addr) rval
     CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
@@ -291,24 +295,58 @@ instance UserOfLocalRegs (CmmNode e x) where
     CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
     _ -> z
     where fold :: forall a b.
-                       UserOfLocalRegs a =>
+                       UserOfRegs LocalReg a =>
                        (b -> LocalReg -> b) -> b -> a -> b
-          fold f z n = foldRegsUsed f z n
+          fold f z n = foldRegsUsed dflags f z n
 
-instance UserOfLocalRegs ForeignTarget where
-  foldRegsUsed _f z (PrimTarget _)      = z
-  foldRegsUsed f  z (ForeignTarget e _) = foldRegsUsed f z e
+instance UserOfRegs GlobalReg (CmmNode e x) where
+  foldRegsUsed dflags f z n = case n of
+    CmmAssign _ expr -> fold f z expr
+    CmmStore addr rval -> fold f (fold f z addr) rval
+    CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args
+    CmmCondBranch expr _ _ -> fold f z expr
+    CmmSwitch expr _ -> fold f z expr
+    CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt
+    CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args
+    _ -> z
+    where fold :: forall a b.
+                       UserOfRegs GlobalReg a =>
+                       (b -> GlobalReg -> b) -> b -> a -> b
+          fold f z n = foldRegsUsed dflags f z n
 
-instance DefinerOfLocalRegs (CmmNode e x) where
-  foldRegsDefd f z n = case n of
+instance UserOfRegs r CmmExpr => UserOfRegs r ForeignTarget where
+  foldRegsUsed _      _ z (PrimTarget _)      = z
+  foldRegsUsed dflags f z (ForeignTarget e _) = foldRegsUsed dflags f z e
+
+instance DefinerOfRegs LocalReg (CmmNode e x) where
+  foldRegsDefd dflags f z n = case n of
     CmmAssign lhs _ -> fold f z lhs
     CmmUnsafeForeignCall _ fs _ -> fold f z fs
     CmmForeignCall {res=res} -> fold f z res
     _ -> z
     where fold :: forall a b.
-                   DefinerOfLocalRegs a =>
+                   DefinerOfRegs LocalReg a =>
                    (b -> LocalReg -> b) -> b -> a -> b
-          fold f z n = foldRegsDefd f z n
+          fold f z n = foldRegsDefd dflags f z n
+
+instance DefinerOfRegs GlobalReg (CmmNode e x) where
+  foldRegsDefd dflags f z n = case n of
+    CmmAssign lhs _ -> fold f z lhs
+    CmmUnsafeForeignCall tgt _ _  -> fold f z (foreignTargetRegs tgt)
+    CmmCall {} -> fold f z activeRegs
+    CmmForeignCall {tgt=tgt} -> fold f z (foreignTargetRegs tgt)
+    _ -> z
+    where fold :: forall a b.
+                   DefinerOfRegs GlobalReg a =>
+                   (b -> GlobalReg -> b) -> b -> a -> b
+          fold f z n = foldRegsDefd dflags f z n
+
+          platform = targetPlatform dflags
+          activeRegs = activeStgRegs platform
+          activeCallerSavesRegs = filter (callerSaves platform) activeRegs
+
+          foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []
+          foreignTargetRegs _ = activeCallerSavesRegs
 
 
 -----------------------------------
diff --git a/compiler/cmm/CmmRewriteAssignments.hs b/compiler/cmm/CmmRewriteAssignments.hs
index 0f2aeaa939..8381d12e7c 100644
--- a/compiler/cmm/CmmRewriteAssignments.hs
+++ b/compiler/cmm/CmmRewriteAssignments.hs
@@ -42,11 +42,11 @@ rewriteAssignments dflags g = do
   -- first perform usage analysis and bake this information into the
   -- graph (backwards transform), and then do a forwards transform
   -- to actually perform inlining and sinking.
-  g'  <- annotateUsage g
+  g'  <- annotateUsage dflags g
   g'' <- liftM fst $ dataflowPassFwd g' [(g_entry g, fact_bot assignmentLattice)] $
                                      analRewFwd assignmentLattice
                                                 (assignmentTransfer dflags)
-                                                (assignmentRewrite `thenFwdRw` machOpFoldRewrite dflags)
+                                                (assignmentRewrite dflags `thenFwdRw` machOpFoldRewrite dflags)
   return (modifyGraph eraseRegUsage g'')
 
 ----------------------------------------------------------------
@@ -159,13 +159,13 @@ data WithRegUsage n e x where
     Plain       :: n e x -> WithRegUsage n e x
     AssignLocal :: LocalReg -> CmmExpr -> RegUsage -> WithRegUsage n O O
 
-instance UserOfLocalRegs (n e x) => UserOfLocalRegs (WithRegUsage n e x) where
-    foldRegsUsed f z (Plain n) = foldRegsUsed f z n
-    foldRegsUsed f z (AssignLocal _ e _) = foldRegsUsed f z e
+instance UserOfRegs LocalReg (n e x) => UserOfRegs LocalReg (WithRegUsage n e x) where
+    foldRegsUsed dflags f z (Plain n) = foldRegsUsed dflags f z n
+    foldRegsUsed dflags f z (AssignLocal _ e _) = foldRegsUsed dflags f z e
 
-instance DefinerOfLocalRegs (n e x) => DefinerOfLocalRegs (WithRegUsage n e x) where
-    foldRegsDefd f z (Plain n) = foldRegsDefd f z n
-    foldRegsDefd f z (AssignLocal r _ _) = foldRegsDefd f z r
+instance DefinerOfRegs LocalReg (n e x) => DefinerOfRegs LocalReg (WithRegUsage n e x) where
+    foldRegsDefd dflags f z (Plain n) = foldRegsDefd dflags f z n
+    foldRegsDefd dflags f z (AssignLocal r _ _) = foldRegsDefd dflags f z r
 
 instance NonLocal n => NonLocal (WithRegUsage n) where
     entryLabel (Plain n) = entryLabel n
@@ -190,8 +190,8 @@ usageLattice = DataflowLattice "usage counts for registers" emptyUFM (joinUFM f)
 
 -- We reuse the names 'gen' and 'kill', although we're doing something
 -- slightly different from the Dragon Book
-usageTransfer :: BwdTransfer (WithRegUsage CmmNode) UsageMap
-usageTransfer = mkBTransfer3 first middle last
+usageTransfer :: DynFlags -> BwdTransfer (WithRegUsage CmmNode) UsageMap
+usageTransfer dflags = mkBTransfer3 first middle last
     where first _ f = f
           middle :: WithRegUsage CmmNode O O -> UsageMap -> UsageMap
           middle n f = gen_kill n f
@@ -209,9 +209,9 @@ usageTransfer = mkBTransfer3 first middle last
           gen_kill :: WithRegUsage CmmNode e x -> UsageMap -> UsageMap
           gen_kill a = gen a . kill a
           gen :: WithRegUsage CmmNode e x -> UsageMap -> UsageMap
-          gen  a f = foldRegsUsed increaseUsage f a
+          gen  a f = foldLocalRegsUsed dflags increaseUsage f a
           kill :: WithRegUsage CmmNode e x -> UsageMap -> UsageMap
-          kill a f = foldRegsDefd delFromUFM f a
+          kill a f = foldLocalRegsDefd dflags delFromUFM f a
           increaseUsage f r = addToUFM_C combine f r SingleUse
             where combine _ _ = ManyUse
 
@@ -228,11 +228,11 @@ usageRewrite = mkBRewrite3 first middle last
           last   _ _ = return Nothing
 
 type CmmGraphWithRegUsage = GenCmmGraph (WithRegUsage CmmNode)
-annotateUsage :: CmmGraph -> UniqSM (CmmGraphWithRegUsage)
-annotateUsage vanilla_g =
+annotateUsage :: DynFlags -> CmmGraph -> UniqSM (CmmGraphWithRegUsage)
+annotateUsage dflags vanilla_g =
     let g = modifyGraph liftRegUsage vanilla_g
     in liftM fst $ dataflowPassBwd g [(g_entry g, fact_bot usageLattice)] $
-                                   analRewBwd usageLattice usageTransfer usageRewrite
+                                   analRewBwd usageLattice (usageTransfer dflags) usageRewrite
 
 ----------------------------------------------------------------
 --- Assignment tracking
@@ -286,8 +286,8 @@ assignmentLattice = DataflowLattice "assignments for registers" emptyUFM (joinUF
 
 -- Deletes sinks from assignment map, because /this/ is the place
 -- where it will be sunk to.
-deleteSinks :: UserOfLocalRegs n => n -> AssignmentMap -> AssignmentMap
-deleteSinks n m = foldRegsUsed (adjustUFM f) m n
+deleteSinks :: UserOfRegs LocalReg n => DynFlags -> n -> AssignmentMap -> AssignmentMap
+deleteSinks dflags n m = foldLocalRegsUsed dflags (adjustUFM f) m n
   where f (AlwaysSink _) = NeverOptimize
         f old = old
 
@@ -319,8 +319,8 @@ middleAssignment :: DynFlags -> WithRegUsage CmmNode O O -> AssignmentMap
 --     the correct optimization policy.
 --  3. Look for all assignments that reference that register and
 --     invalidate them.
-middleAssignment _ n@(AssignLocal r e usage) assign
-    = invalidateUsersOf (CmmLocal r) . add . deleteSinks n $ assign
+middleAssignment dflags n@(AssignLocal r e usage) assign
+    = invalidateUsersOf (CmmLocal r) . add . deleteSinks dflags n $ assign
       where add m = addToUFM m r
                   $ case usage of
                         SingleUse -> AlwaysInline e
@@ -339,8 +339,8 @@ middleAssignment _ n@(AssignLocal r e usage) assign
 -- 1. Delete any sinking assignments that were used by this instruction
 -- 2. Look for all assignments that reference this register and
 --    invalidate them.
-middleAssignment _ (Plain n@(CmmAssign reg@(CmmGlobal _) _)) assign
-    = invalidateUsersOf reg . deleteSinks n $ assign
+middleAssignment dflags (Plain n@(CmmAssign reg@(CmmGlobal _) _)) assign
+    = invalidateUsersOf reg . deleteSinks dflags n $ assign
 
 -- Algorithm for unannotated assignments of *local* registers: do
 -- nothing (it's a reload, so no state should have changed)
@@ -351,7 +351,7 @@ middleAssignment _ (Plain (CmmAssign (CmmLocal _) _)) assign = assign
 --  2. Look for all assignments that load from memory locations that
 --     were clobbered by this store and invalidate them.
 middleAssignment dflags (Plain n@(CmmStore lhs rhs)) assign
-    = let m = deleteSinks n assign
+    = let m = deleteSinks dflags n assign
       in foldUFM_Directly f m m -- [foldUFM performance]
       where f u (xassign -> Just x) m | clobbers dflags (lhs, rhs) (u, x) = addToUFM_Directly m u NeverOptimize
             f _ _ m = m
@@ -373,7 +373,7 @@ middleAssignment dflags (Plain n@(CmmStore lhs rhs)) assign
 -- store extra information about expressions that allow this and other
 -- checks to be done cheaply.)
 middleAssignment dflags (Plain n@(CmmUnsafeForeignCall{})) assign
-    = deleteCallerSaves (foldRegsDefd (\m r -> addToUFM m r NeverOptimize) (deleteSinks n assign) n)
+    = deleteCallerSaves (foldLocalRegsDefd dflags (\m r -> addToUFM m r NeverOptimize) (deleteSinks dflags n assign) n)
     where deleteCallerSaves m = foldUFM_Directly f m m
           f u (xassign -> Just x) m | wrapRecExpf g x False = addToUFM_Directly m u NeverOptimize
           f _ _ m = m
@@ -442,10 +442,10 @@ overlaps (_, o, w) (_, o', w') =
         s' = o' - w'
     in (s' < o) && (s < o) -- Not LTE, because [ I32  ][ I32  ] is OK
 
-lastAssignment :: WithRegUsage CmmNode O C -> AssignmentMap -> [(Label, AssignmentMap)]
-lastAssignment (Plain (CmmCall _ (Just k) _ _ _ _)) assign = [(k, invalidateVolatile k assign)]
-lastAssignment (Plain (CmmForeignCall {succ=k}))  assign = [(k, invalidateVolatile k assign)]
-lastAssignment l assign = map (\id -> (id, deleteSinks l assign)) $ successors l
+lastAssignment :: DynFlags -> WithRegUsage CmmNode O C -> AssignmentMap -> [(Label, AssignmentMap)]
+lastAssignment _ (Plain (CmmCall _ (Just k) _ _ _ _)) assign = [(k, invalidateVolatile k assign)]
+lastAssignment _ (Plain (CmmForeignCall {succ=k}))  assign = [(k, invalidateVolatile k assign)]
+lastAssignment dflags l assign = map (\id -> (id, deleteSinks dflags l assign)) $ successors l
 
 -- Invalidates any expressions that have volatile contents: essentially,
 -- all terminals volatile except for literals and loads of stack slots
@@ -471,7 +471,7 @@ assignmentTransfer :: DynFlags
 assignmentTransfer dflags
     = mkFTransfer3 (flip const)
                    (middleAssignment dflags)
-                   ((mkFactBase assignmentLattice .) . lastAssignment)
+                   ((mkFactBase assignmentLattice .) . lastAssignment dflags)
 
 -- Note [Soundness of inlining]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -533,8 +533,8 @@ assignmentTransfer dflags
 -- values from the assignment map, due to reassignment of the local
 -- register.)  This is probably not locally sound.
 
-assignmentRewrite :: FwdRewrite UniqSM (WithRegUsage CmmNode) AssignmentMap
-assignmentRewrite = mkFRewrite3 first middle last
+assignmentRewrite :: DynFlags -> FwdRewrite UniqSM (WithRegUsage CmmNode) AssignmentMap
+assignmentRewrite dflags = mkFRewrite3 first middle last
     where
         first _ _ = return Nothing
         middle :: WithRegUsage CmmNode O O -> AssignmentMap -> GenCmmReplGraph (WithRegUsage CmmNode) O O
@@ -543,7 +543,7 @@ assignmentRewrite = mkFRewrite3 first middle last
         last (Plain l) assign = return $ rewrite assign (precompute assign l) mkLast l
         -- Tuple is (inline?, reloads for sinks)
         precompute :: AssignmentMap -> CmmNode O x -> (Bool, [WithRegUsage CmmNode O O])
-        precompute assign n = foldRegsUsed f (False, []) n -- duplicates are harmless
+        precompute assign n = foldLocalRegsUsed dflags f (False, []) n -- duplicates are harmless
             where f (i, l) r = case lookupUFM assign r of
                                 Just (AlwaysSink e)   -> (i, (Plain (CmmAssign (CmmLocal r) e)):l)
                                 Just (AlwaysInline _) -> (True, l)
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 7553e37325..2a080c2e58 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -125,7 +125,7 @@ type Assignment = (LocalReg, CmmExpr, AbsMem)
 cmmSink :: DynFlags -> CmmGraph -> CmmGraph
 cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
   where
-  liveness = cmmLiveness graph
+  liveness = cmmLocalLiveness dflags graph
   getLive l = mapFindWithDefault Set.empty l liveness
 
   blocks = postorderDfs graph
@@ -147,8 +147,8 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
       -- the node.  This will help us decide whether we can inline
       -- an assignment in the current node or not.
       live = Set.unions (map getLive succs)
-      live_middle = gen_kill last live
-      ann_middles = annotate live_middle (blockToList middle)
+      live_middle = gen_kill dflags last live
+      ann_middles = annotate dflags live_middle (blockToList middle)
 
       -- Now sink and inline in this block
       (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk)
@@ -187,7 +187,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
             upd set | r `Set.member` set = set `Set.union` live_rhs
                     | otherwise          = set
 
-            live_rhs = foldRegsUsed extendRegSet emptyRegSet rhs
+            live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs
 
       final_middle = foldl blockSnoc middle' dropped_last
 
@@ -215,9 +215,9 @@ isTrivial _ = False
 --
 -- annotate each node with the set of registers live *after* the node
 --
-annotate :: RegSet -> [CmmNode O O] -> [(RegSet, CmmNode O O)]
-annotate live nodes = snd $ foldr ann (live,[]) nodes
-  where ann n (live,nodes) = (gen_kill n live, (live,n) : nodes)
+annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)]
+annotate dflags live nodes = snd $ foldr ann (live,[]) nodes
+  where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes)
 
 --
 -- Find the blocks that have multiple successors (join points)
@@ -234,7 +234,7 @@ findJoinPoints blocks = mapFilter (>1) succ_counts
 -- filter the list of assignments to remove any assignments that
 -- are not live in a continuation.
 --
-filterAssignments :: DynFlags -> RegSet -> [Assignment] -> [Assignment]
+filterAssignments :: DynFlags -> LocalRegSet -> [Assignment] -> [Assignment]
 filterAssignments dflags live assigs = reverse (go assigs [])
   where go []             kept = kept
         go (a@(r,_,_):as) kept | needed    = go as (a:kept)
@@ -251,7 +251,7 @@ filterAssignments dflags live assigs = reverse (go assigs [])
 -- as we go.
 
 walk :: DynFlags
-     -> [(RegSet, CmmNode O O)]         -- nodes of the block, annotated with
+     -> [(LocalRegSet, CmmNode O O)]    -- nodes of the block, annotated with
                                         -- the set of registers live *after*
                                         -- this node.
 
@@ -310,7 +310,7 @@ shouldSink _ _other = Nothing
 -- out of inlining, but the inliner will see that r is live
 -- after the instruction and choose not to inline r in the rhs.
 --
-shouldDiscard :: CmmNode e x -> RegSet -> Bool
+shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool
 shouldDiscard node live
    = case node of
        CmmAssign r (CmmReg r') | r == r' -> True
@@ -346,7 +346,7 @@ dropAssignments dflags should_drop state assigs
 
 tryToInline
    :: DynFlags
-   -> RegSet                    -- set of registers live after this
+   -> LocalRegSet               -- set of registers live after this
                                 -- node.  We cannot inline anything
                                 -- that is live after the node, unless
                                 -- it is small enough to duplicate.
@@ -360,7 +360,7 @@ tryToInline
 tryToInline dflags live node assigs = go usages node [] assigs
  where
   usages :: UniqFM Int
-  usages = foldRegsUsed addUsage emptyUFM node
+  usages = foldRegsUsed dflags addUsage emptyUFM node
 
   go _usages node _skipped [] = (node, [])
 
@@ -371,14 +371,14 @@ tryToInline dflags live node assigs = go usages node [] assigs
    | otherwise               = dont_inline
    where
         inline_and_discard = go usages' inl_node skipped rest
-          where usages' = foldRegsUsed addUsage usages rhs
+          where usages' = foldRegsUsed dflags addUsage usages rhs
 
         dont_inline        = keep node  -- don't inline the assignment, keep it
         inline_and_keep    = keep inl_node -- inline the assignment, keep it
 
         keep node' = (final_node, a : rest')
           where (final_node, rest') = go usages' node' (l:skipped) rest
-                usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs
+                usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) usages rhs
                 -- we must not inline anything that is mentioned in the RHS
                 -- of a binding that we have already skipped, so we set the
                 -- usages of the regs on the RHS to 2.
@@ -458,7 +458,7 @@ conflicts dflags (r, rhs, addr) node
 
   -- (1) an assignment to a register conflicts with a use of the register
   | CmmAssign reg  _ <- node, reg `regUsedIn` rhs                 = True
-  | foldRegsUsed (\b r' -> r == r' || b) False node               = True
+  | foldRegsUsed dflags (\b r' -> r == r' || b) False node        = True
 
   -- (2) a store to an address conflicts with a read of the same memory
   | CmmStore addr' e <- node
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index 00f88a4e35..8d5c0398cf 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 -----------------------------------------------------------------------------
 --
 -- Old-style Cmm data types
@@ -86,8 +88,8 @@ type RawCmmDecl = GenCmmDecl CmmStatics (BlockEnv CmmStatics) (ListGraph CmmStmt
 data GenBasicBlock i = BasicBlock BlockId [i]
 type CmmBasicBlock   = GenBasicBlock CmmStmt
 
-instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
-    foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l
+instance UserOfRegs r i => UserOfRegs r (GenBasicBlock i) where
+    foldRegsUsed dflags f set (BasicBlock _ l) = foldRegsUsed dflags f set l
 
 -- | The branch block id is that of the first block in
 -- the branch, which is that branch's entry point
@@ -187,8 +189,8 @@ data CmmSafety
   | CmmInterruptible
 
 -- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
-instance UserOfLocalRegs CmmStmt where
-  foldRegsUsed f (set::b) s = stmt s set
+instance UserOfRegs LocalReg CmmStmt where
+  foldRegsUsed dflags f (set::b) s = stmt s set
     where
       stmt :: CmmStmt -> b -> b
       stmt (CmmNop)                  = id
@@ -202,18 +204,18 @@ instance UserOfLocalRegs CmmStmt where
       stmt (CmmJump e _)             = gen e
       stmt (CmmReturn)               = id
 
-      gen :: UserOfLocalRegs a => a -> b -> b
-      gen a set = foldRegsUsed f set a
+      gen :: UserOfRegs LocalReg a => a -> b -> b
+      gen a set = foldRegsUsed dflags f set a
 
-instance UserOfLocalRegs CmmCallTarget where
-    foldRegsUsed f set (CmmCallee e _)    = foldRegsUsed f set e
-    foldRegsUsed f set (CmmPrim _ mStmts) = foldRegsUsed f set mStmts
+instance UserOfRegs LocalReg CmmCallTarget where
+    foldRegsUsed dflags f set (CmmCallee e _)    = foldRegsUsed dflags f set e
+    foldRegsUsed dflags f set (CmmPrim _ mStmts) = foldRegsUsed dflags f set mStmts
 
-instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
-    foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
+instance UserOfRegs r a => UserOfRegs r (CmmHinted a) where
+    foldRegsUsed dflags f set a = foldRegsUsed dflags f set (hintlessCmm a)
 
-instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
-    foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
+instance DefinerOfRegs r a => DefinerOfRegs r (CmmHinted a) where
+    foldRegsDefd dflags f set a = foldRegsDefd dflags f set (hintlessCmm a)
 
 {-
 Discussion